line |
stmt |
bran |
cond |
sub |
time |
code |
1
|
|
|
|
|
|
/* hv.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
|
|
|
|
|
|
* I sit beside the fire and think |
13
|
|
|
|
|
|
* of all that I have seen. |
14
|
|
|
|
|
|
* --Bilbo |
15
|
|
|
|
|
|
* |
16
|
|
|
|
|
|
* [p.278 of _The Lord of the Rings_, II/iii: "The Ring Goes South"] |
17
|
|
|
|
|
|
*/ |
18
|
|
|
|
|
|
|
19
|
|
|
|
|
|
/* |
20
|
|
|
|
|
|
=head1 Hash Manipulation Functions |
21
|
|
|
|
|
|
|
22
|
|
|
|
|
|
A HV structure represents a Perl hash. It consists mainly of an array |
23
|
|
|
|
|
|
of pointers, each of which points to a linked list of HE structures. The |
24
|
|
|
|
|
|
array is indexed by the hash function of the key, so each linked list |
25
|
|
|
|
|
|
represents all the hash entries with the same hash value. Each HE contains |
26
|
|
|
|
|
|
a pointer to the actual value, plus a pointer to a HEK structure which |
27
|
|
|
|
|
|
holds the key and hash value. |
28
|
|
|
|
|
|
|
29
|
|
|
|
|
|
=cut |
30
|
|
|
|
|
|
|
31
|
|
|
|
|
|
*/ |
32
|
|
|
|
|
|
|
33
|
|
|
|
|
|
#include "EXTERN.h" |
34
|
|
|
|
|
|
#define PERL_IN_HV_C |
35
|
|
|
|
|
|
#define PERL_HASH_INTERNAL_ACCESS |
36
|
|
|
|
|
|
#include "perl.h" |
37
|
|
|
|
|
|
|
38
|
|
|
|
|
|
#define DO_HSPLIT(xhv) ((xhv)->xhv_keys > (xhv)->xhv_max) /* HvTOTALKEYS(hv) > HvMAX(hv) */ |
39
|
|
|
|
|
|
#define HV_FILL_THRESHOLD 31 |
40
|
|
|
|
|
|
|
41
|
|
|
|
|
|
static const char S_strtab_error[] |
42
|
|
|
|
|
|
= "Cannot modify shared string table in hv_%s"; |
43
|
|
|
|
|
|
|
44
|
|
|
|
|
|
#ifdef PURIFY |
45
|
|
|
|
|
|
|
46
|
|
|
|
|
|
#define new_HE() (HE*)safemalloc(sizeof(HE)) |
47
|
|
|
|
|
|
#define del_HE(p) safefree((char*)p) |
48
|
|
|
|
|
|
|
49
|
|
|
|
|
|
#else |
50
|
|
|
|
|
|
|
51
|
|
|
|
|
|
STATIC HE* |
52
|
516333226
|
|
|
|
|
S_new_he(pTHX) |
53
|
|
|
|
|
|
{ |
54
|
|
|
|
|
|
dVAR; |
55
|
|
|
|
|
|
HE* he; |
56
|
|
|
|
|
|
void ** const root = &PL_body_roots[HE_SVSLOT]; |
57
|
|
|
|
|
|
|
58
|
516333226
|
100
|
|
|
|
if (!*root) |
59
|
1042555
|
|
|
|
|
Perl_more_bodies(aTHX_ HE_SVSLOT, sizeof(HE), PERL_ARENA_SIZE); |
60
|
516333226
|
|
|
|
|
he = (HE*) *root; |
61
|
|
|
|
|
|
assert(he); |
62
|
516333226
|
|
|
|
|
*root = HeNEXT(he); |
63
|
516333226
|
|
|
|
|
return he; |
64
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
66
|
|
|
|
|
|
#define new_HE() new_he() |
67
|
|
|
|
|
|
#define del_HE(p) \ |
68
|
|
|
|
|
|
STMT_START { \ |
69
|
|
|
|
|
|
HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \ |
70
|
|
|
|
|
|
PL_body_roots[HE_SVSLOT] = p; \ |
71
|
|
|
|
|
|
} STMT_END |
72
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
75
|
|
|
|
|
|
#endif |
76
|
|
|
|
|
|
|
77
|
|
|
|
|
|
STATIC HEK * |
78
|
0
|
|
|
|
|
S_save_hek_flags(const char *str, I32 len, U32 hash, int flags) |
79
|
|
|
|
|
|
{ |
80
|
0
|
|
|
|
|
const int flags_masked = flags & HVhek_MASK; |
81
|
|
|
|
|
|
char *k; |
82
|
|
|
|
|
|
HEK *hek; |
83
|
|
|
|
|
|
|
84
|
|
|
|
|
|
PERL_ARGS_ASSERT_SAVE_HEK_FLAGS; |
85
|
|
|
|
|
|
|
86
|
0
|
|
|
|
|
Newx(k, HEK_BASESIZE + len + 2, char); |
87
|
|
|
|
|
|
hek = (HEK*)k; |
88
|
0
|
|
|
|
|
Copy(str, HEK_KEY(hek), len, char); |
89
|
0
|
|
|
|
|
HEK_KEY(hek)[len] = 0; |
90
|
0
|
|
|
|
|
HEK_LEN(hek) = len; |
91
|
0
|
|
|
|
|
HEK_HASH(hek) = hash; |
92
|
0
|
|
|
|
|
HEK_FLAGS(hek) = (unsigned char)flags_masked | HVhek_UNSHARED; |
93
|
|
|
|
|
|
|
94
|
0
|
0
|
|
|
|
if (flags & HVhek_FREEKEY) |
95
|
0
|
|
|
|
|
Safefree(str); |
96
|
0
|
|
|
|
|
return hek; |
97
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
99
|
|
|
|
|
|
/* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent |
100
|
|
|
|
|
|
* for tied hashes */ |
101
|
|
|
|
|
|
|
102
|
|
|
|
|
|
void |
103
|
0
|
|
|
|
|
Perl_free_tied_hv_pool(pTHX) |
104
|
|
|
|
|
|
{ |
105
|
|
|
|
|
|
dVAR; |
106
|
0
|
|
|
|
|
HE *he = PL_hv_fetch_ent_mh; |
107
|
0
|
0
|
|
|
|
while (he) { |
108
|
|
|
|
|
|
HE * const ohe = he; |
109
|
0
|
|
|
|
|
Safefree(HeKEY_hek(he)); |
110
|
0
|
|
|
|
|
he = HeNEXT(he); |
111
|
0
|
|
|
|
|
del_HE(ohe); |
112
|
|
|
|
|
|
} |
113
|
0
|
|
|
|
|
PL_hv_fetch_ent_mh = NULL; |
114
|
0
|
|
|
|
|
} |
115
|
|
|
|
|
|
|
116
|
|
|
|
|
|
#if defined(USE_ITHREADS) |
117
|
|
|
|
|
|
HEK * |
118
|
|
|
|
|
|
Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) |
119
|
|
|
|
|
|
{ |
120
|
|
|
|
|
|
HEK *shared; |
121
|
|
|
|
|
|
|
122
|
|
|
|
|
|
PERL_ARGS_ASSERT_HEK_DUP; |
123
|
|
|
|
|
|
PERL_UNUSED_ARG(param); |
124
|
|
|
|
|
|
|
125
|
|
|
|
|
|
if (!source) |
126
|
|
|
|
|
|
return NULL; |
127
|
|
|
|
|
|
|
128
|
|
|
|
|
|
shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); |
129
|
|
|
|
|
|
if (shared) { |
130
|
|
|
|
|
|
/* We already shared this hash key. */ |
131
|
|
|
|
|
|
(void)share_hek_hek(shared); |
132
|
|
|
|
|
|
} |
133
|
|
|
|
|
|
else { |
134
|
|
|
|
|
|
shared |
135
|
|
|
|
|
|
= share_hek_flags(HEK_KEY(source), HEK_LEN(source), |
136
|
|
|
|
|
|
HEK_HASH(source), HEK_FLAGS(source)); |
137
|
|
|
|
|
|
ptr_table_store(PL_ptr_table, source, shared); |
138
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
return shared; |
140
|
|
|
|
|
|
} |
141
|
|
|
|
|
|
|
142
|
|
|
|
|
|
HE * |
143
|
|
|
|
|
|
Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) |
144
|
|
|
|
|
|
{ |
145
|
|
|
|
|
|
HE *ret; |
146
|
|
|
|
|
|
|
147
|
|
|
|
|
|
PERL_ARGS_ASSERT_HE_DUP; |
148
|
|
|
|
|
|
|
149
|
|
|
|
|
|
if (!e) |
150
|
|
|
|
|
|
return NULL; |
151
|
|
|
|
|
|
/* look for it in the table first */ |
152
|
|
|
|
|
|
ret = (HE*)ptr_table_fetch(PL_ptr_table, e); |
153
|
|
|
|
|
|
if (ret) |
154
|
|
|
|
|
|
return ret; |
155
|
|
|
|
|
|
|
156
|
|
|
|
|
|
/* create anew and remember what it is */ |
157
|
|
|
|
|
|
ret = new_HE(); |
158
|
|
|
|
|
|
ptr_table_store(PL_ptr_table, e, ret); |
159
|
|
|
|
|
|
|
160
|
|
|
|
|
|
HeNEXT(ret) = he_dup(HeNEXT(e),shared, param); |
161
|
|
|
|
|
|
if (HeKLEN(e) == HEf_SVKEY) { |
162
|
|
|
|
|
|
char *k; |
163
|
|
|
|
|
|
Newx(k, HEK_BASESIZE + sizeof(const SV *), char); |
164
|
|
|
|
|
|
HeKEY_hek(ret) = (HEK*)k; |
165
|
|
|
|
|
|
HeKEY_sv(ret) = sv_dup_inc(HeKEY_sv(e), param); |
166
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
else if (shared) { |
168
|
|
|
|
|
|
/* This is hek_dup inlined, which seems to be important for speed |
169
|
|
|
|
|
|
reasons. */ |
170
|
|
|
|
|
|
HEK * const source = HeKEY_hek(e); |
171
|
|
|
|
|
|
HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source); |
172
|
|
|
|
|
|
|
173
|
|
|
|
|
|
if (shared) { |
174
|
|
|
|
|
|
/* We already shared this hash key. */ |
175
|
|
|
|
|
|
(void)share_hek_hek(shared); |
176
|
|
|
|
|
|
} |
177
|
|
|
|
|
|
else { |
178
|
|
|
|
|
|
shared |
179
|
|
|
|
|
|
= share_hek_flags(HEK_KEY(source), HEK_LEN(source), |
180
|
|
|
|
|
|
HEK_HASH(source), HEK_FLAGS(source)); |
181
|
|
|
|
|
|
ptr_table_store(PL_ptr_table, source, shared); |
182
|
|
|
|
|
|
} |
183
|
|
|
|
|
|
HeKEY_hek(ret) = shared; |
184
|
|
|
|
|
|
} |
185
|
|
|
|
|
|
else |
186
|
|
|
|
|
|
HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e), |
187
|
|
|
|
|
|
HeKFLAGS(e)); |
188
|
|
|
|
|
|
HeVAL(ret) = sv_dup_inc(HeVAL(e), param); |
189
|
|
|
|
|
|
return ret; |
190
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
#endif /* USE_ITHREADS */ |
192
|
|
|
|
|
|
|
193
|
|
|
|
|
|
static void |
194
|
242
|
|
|
|
|
S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen, |
195
|
|
|
|
|
|
const char *msg) |
196
|
|
|
|
|
|
{ |
197
|
242
|
|
|
|
|
SV * const sv = sv_newmortal(); |
198
|
|
|
|
|
|
|
199
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_NOTALLOWED; |
200
|
|
|
|
|
|
|
201
|
242
|
50
|
|
|
|
if (!(flags & HVhek_FREEKEY)) { |
202
|
242
|
|
|
|
|
sv_setpvn(sv, key, klen); |
203
|
|
|
|
|
|
} |
204
|
|
|
|
|
|
else { |
205
|
|
|
|
|
|
/* Need to free saved eventually assign to mortal SV */ |
206
|
|
|
|
|
|
/* XXX is this line an error ???: SV *sv = sv_newmortal(); */ |
207
|
0
|
|
|
|
|
sv_usepvn(sv, (char *) key, klen); |
208
|
|
|
|
|
|
} |
209
|
242
|
50
|
|
|
|
if (flags & HVhek_UTF8) { |
210
|
0
|
|
|
|
|
SvUTF8_on(sv); |
211
|
|
|
|
|
|
} |
212
|
242
|
|
|
|
|
Perl_croak(aTHX_ msg, SVfARG(sv)); |
213
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
215
|
|
|
|
|
|
/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot |
216
|
|
|
|
|
|
* contains an SV* */ |
217
|
|
|
|
|
|
|
218
|
|
|
|
|
|
/* |
219
|
|
|
|
|
|
=for apidoc hv_store |
220
|
|
|
|
|
|
|
221
|
|
|
|
|
|
Stores an SV in a hash. The hash key is specified as C and the |
222
|
|
|
|
|
|
absolute value of C is the length of the key. If C is |
223
|
|
|
|
|
|
negative the key is assumed to be in UTF-8-encoded Unicode. The |
224
|
|
|
|
|
|
C parameter is the precomputed hash value; if it is zero then |
225
|
|
|
|
|
|
Perl will compute it. |
226
|
|
|
|
|
|
|
227
|
|
|
|
|
|
The return value will be |
228
|
|
|
|
|
|
NULL if the operation failed or if the value did not need to be actually |
229
|
|
|
|
|
|
stored within the hash (as in the case of tied hashes). Otherwise it can |
230
|
|
|
|
|
|
be dereferenced to get the original C. Note that the caller is |
231
|
|
|
|
|
|
responsible for suitably incrementing the reference count of C before |
232
|
|
|
|
|
|
the call, and decrementing it if the function returned NULL. Effectively |
233
|
|
|
|
|
|
a successful hv_store takes ownership of one reference to C. This is |
234
|
|
|
|
|
|
usually what you want; a newly created SV has a reference count of one, so |
235
|
|
|
|
|
|
if all your code does is create SVs then store them in a hash, hv_store |
236
|
|
|
|
|
|
will own the only reference to the new SV, and your code doesn't need to do |
237
|
|
|
|
|
|
anything further to tidy up. hv_store is not implemented as a call to |
238
|
|
|
|
|
|
hv_store_ent, and does not create a temporary SV for the key, so if your |
239
|
|
|
|
|
|
key data is not already in SV form then use hv_store in preference to |
240
|
|
|
|
|
|
hv_store_ent. |
241
|
|
|
|
|
|
|
242
|
|
|
|
|
|
See L for more |
243
|
|
|
|
|
|
information on how to use this function on tied hashes. |
244
|
|
|
|
|
|
|
245
|
|
|
|
|
|
=for apidoc hv_store_ent |
246
|
|
|
|
|
|
|
247
|
|
|
|
|
|
Stores C in a hash. The hash key is specified as C. The C |
248
|
|
|
|
|
|
parameter is the precomputed hash value; if it is zero then Perl will |
249
|
|
|
|
|
|
compute it. The return value is the new hash entry so created. It will be |
250
|
|
|
|
|
|
NULL if the operation failed or if the value did not need to be actually |
251
|
|
|
|
|
|
stored within the hash (as in the case of tied hashes). Otherwise the |
252
|
|
|
|
|
|
contents of the return value can be accessed using the C macros |
253
|
|
|
|
|
|
described here. Note that the caller is responsible for suitably |
254
|
|
|
|
|
|
incrementing the reference count of C before the call, and |
255
|
|
|
|
|
|
decrementing it if the function returned NULL. Effectively a successful |
256
|
|
|
|
|
|
hv_store_ent takes ownership of one reference to C. This is |
257
|
|
|
|
|
|
usually what you want; a newly created SV has a reference count of one, so |
258
|
|
|
|
|
|
if all your code does is create SVs then store them in a hash, hv_store |
259
|
|
|
|
|
|
will own the only reference to the new SV, and your code doesn't need to do |
260
|
|
|
|
|
|
anything further to tidy up. Note that hv_store_ent only reads the C; |
261
|
|
|
|
|
|
unlike C it does not take ownership of it, so maintaining the correct |
262
|
|
|
|
|
|
reference count on C is entirely the caller's responsibility. hv_store |
263
|
|
|
|
|
|
is not implemented as a call to hv_store_ent, and does not create a temporary |
264
|
|
|
|
|
|
SV for the key, so if your key data is not already in SV form then use |
265
|
|
|
|
|
|
hv_store in preference to hv_store_ent. |
266
|
|
|
|
|
|
|
267
|
|
|
|
|
|
See L for more |
268
|
|
|
|
|
|
information on how to use this function on tied hashes. |
269
|
|
|
|
|
|
|
270
|
|
|
|
|
|
=for apidoc hv_exists |
271
|
|
|
|
|
|
|
272
|
|
|
|
|
|
Returns a boolean indicating whether the specified hash key exists. The |
273
|
|
|
|
|
|
absolute value of C is the length of the key. If C is |
274
|
|
|
|
|
|
negative the key is assumed to be in UTF-8-encoded Unicode. |
275
|
|
|
|
|
|
|
276
|
|
|
|
|
|
=for apidoc hv_fetch |
277
|
|
|
|
|
|
|
278
|
|
|
|
|
|
Returns the SV which corresponds to the specified key in the hash. |
279
|
|
|
|
|
|
The absolute value of C is the length of the key. If C is |
280
|
|
|
|
|
|
negative the key is assumed to be in UTF-8-encoded Unicode. If |
281
|
|
|
|
|
|
C is set then the fetch will be part of a store. This means that if |
282
|
|
|
|
|
|
there is no value in the hash associated with the given key, then one is |
283
|
|
|
|
|
|
created and a pointer to it is returned. The C it points to can be |
284
|
|
|
|
|
|
assigned to. But always check that the |
285
|
|
|
|
|
|
return value is non-null before dereferencing it to an C. |
286
|
|
|
|
|
|
|
287
|
|
|
|
|
|
See L for more |
288
|
|
|
|
|
|
information on how to use this function on tied hashes. |
289
|
|
|
|
|
|
|
290
|
|
|
|
|
|
=for apidoc hv_exists_ent |
291
|
|
|
|
|
|
|
292
|
|
|
|
|
|
Returns a boolean indicating whether |
293
|
|
|
|
|
|
the specified hash key exists. C |
294
|
|
|
|
|
|
can be a valid precomputed hash value, or 0 to ask for it to be |
295
|
|
|
|
|
|
computed. |
296
|
|
|
|
|
|
|
297
|
|
|
|
|
|
=cut |
298
|
|
|
|
|
|
*/ |
299
|
|
|
|
|
|
|
300
|
|
|
|
|
|
/* returns an HE * structure with the all fields set */ |
301
|
|
|
|
|
|
/* note that hent_val will be a mortal sv for MAGICAL hashes */ |
302
|
|
|
|
|
|
/* |
303
|
|
|
|
|
|
=for apidoc hv_fetch_ent |
304
|
|
|
|
|
|
|
305
|
|
|
|
|
|
Returns the hash entry which corresponds to the specified key in the hash. |
306
|
|
|
|
|
|
C must be a valid precomputed hash number for the given C, or 0 |
307
|
|
|
|
|
|
if you want the function to compute it. IF C is set then the fetch |
308
|
|
|
|
|
|
will be part of a store. Make sure the return value is non-null before |
309
|
|
|
|
|
|
accessing it. The return value when C is a tied hash is a pointer to a |
310
|
|
|
|
|
|
static location, so be sure to make a copy of the structure if you need to |
311
|
|
|
|
|
|
store it somewhere. |
312
|
|
|
|
|
|
|
313
|
|
|
|
|
|
See L for more |
314
|
|
|
|
|
|
information on how to use this function on tied hashes. |
315
|
|
|
|
|
|
|
316
|
|
|
|
|
|
=cut |
317
|
|
|
|
|
|
*/ |
318
|
|
|
|
|
|
|
319
|
|
|
|
|
|
/* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store() */ |
320
|
|
|
|
|
|
void * |
321
|
3735448943
|
|
|
|
|
Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32, |
322
|
|
|
|
|
|
const int action, SV *val, const U32 hash) |
323
|
|
|
|
|
|
{ |
324
|
|
|
|
|
|
STRLEN klen; |
325
|
|
|
|
|
|
int flags; |
326
|
|
|
|
|
|
|
327
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_COMMON_KEY_LEN; |
328
|
|
|
|
|
|
|
329
|
3735448943
|
100
|
|
|
|
if (klen_i32 < 0) { |
330
|
152512
|
|
|
|
|
klen = -klen_i32; |
331
|
|
|
|
|
|
flags = HVhek_UTF8; |
332
|
|
|
|
|
|
} else { |
333
|
3735296431
|
|
|
|
|
klen = klen_i32; |
334
|
|
|
|
|
|
flags = 0; |
335
|
|
|
|
|
|
} |
336
|
3735448943
|
|
|
|
|
return hv_common(hv, NULL, key, klen, flags, action, val, hash); |
337
|
|
|
|
|
|
} |
338
|
|
|
|
|
|
|
339
|
|
|
|
|
|
void * |
340
|
5167276153
|
|
|
|
|
Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, |
341
|
|
|
|
|
|
int flags, int action, SV *val, U32 hash) |
342
|
|
|
|
|
|
{ |
343
|
|
|
|
|
|
dVAR; |
344
|
|
|
|
|
|
XPVHV* xhv; |
345
|
|
|
|
|
|
HE *entry; |
346
|
|
|
|
|
|
HE **oentry; |
347
|
|
|
|
|
|
SV *sv; |
348
|
|
|
|
|
|
bool is_utf8; |
349
|
|
|
|
|
|
int masked_flags; |
350
|
5167276153
|
|
|
|
|
const int return_svp = action & HV_FETCH_JUST_SV; |
351
|
|
|
|
|
|
|
352
|
5167276153
|
100
|
|
|
|
if (!hv) |
353
|
|
|
|
|
|
return NULL; |
354
|
5167275157
|
50
|
|
|
|
if (SvTYPE(hv) == (svtype)SVTYPEMASK) |
355
|
|
|
|
|
|
return NULL; |
356
|
|
|
|
|
|
|
357
|
|
|
|
|
|
assert(SvTYPE(hv) == SVt_PVHV); |
358
|
|
|
|
|
|
|
359
|
5167275157
|
100
|
|
|
|
if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) { |
|
|
100
|
|
|
|
|
360
|
|
|
|
|
|
MAGIC* mg; |
361
|
80714
|
50
|
|
|
|
if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) { |
362
|
80714
|
|
|
|
|
struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr; |
363
|
80714
|
100
|
|
|
|
if (uf->uf_set == NULL) { |
364
|
80682
|
|
|
|
|
SV* obj = mg->mg_obj; |
365
|
|
|
|
|
|
|
366
|
80682
|
50
|
|
|
|
if (!keysv) { |
367
|
0
|
0
|
|
|
|
keysv = newSVpvn_flags(key, klen, SVs_TEMP | |
368
|
|
|
|
|
|
((flags & HVhek_UTF8) |
369
|
|
|
|
|
|
? SVf_UTF8 : 0)); |
370
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
372
|
80682
|
|
|
|
|
mg->mg_obj = keysv; /* pass key */ |
373
|
80682
|
|
|
|
|
uf->uf_index = action; /* pass action */ |
374
|
80682
|
|
|
|
|
magic_getuvar(MUTABLE_SV(hv), mg); |
375
|
80682
|
|
|
|
|
keysv = mg->mg_obj; /* may have changed */ |
376
|
80682
|
|
|
|
|
mg->mg_obj = obj; |
377
|
|
|
|
|
|
|
378
|
|
|
|
|
|
/* If the key may have changed, then we need to invalidate |
379
|
|
|
|
|
|
any passed-in computed hash value. */ |
380
|
|
|
|
|
|
hash = 0; |
381
|
|
|
|
|
|
} |
382
|
|
|
|
|
|
} |
383
|
|
|
|
|
|
} |
384
|
5167275157
|
100
|
|
|
|
if (keysv) { |
385
|
1370499898
|
50
|
|
|
|
if (flags & HVhek_FREEKEY) |
386
|
0
|
|
|
|
|
Safefree(key); |
387
|
1370499898
|
100
|
|
|
|
key = SvPV_const(keysv, klen); |
388
|
1370499898
|
|
|
|
|
is_utf8 = (SvUTF8(keysv) != 0); |
389
|
1370499898
|
100
|
|
|
|
if (SvIsCOW_shared_hash(keysv)) { |
|
|
100
|
|
|
|
|
390
|
982262392
|
|
|
|
|
flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0); |
391
|
|
|
|
|
|
} else { |
392
|
388237506
|
|
|
|
|
flags = is_utf8 ? HVhek_UTF8 : 0; |
393
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
} else { |
395
|
3796775259
|
|
|
|
|
is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE); |
396
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
398
|
5167275157
|
100
|
|
|
|
if (action & HV_DELETE) { |
399
|
20758347
|
|
|
|
|
return (void *) hv_delete_common(hv, keysv, key, klen, |
400
|
|
|
|
|
|
flags, action, hash); |
401
|
|
|
|
|
|
} |
402
|
|
|
|
|
|
|
403
|
5146516810
|
|
|
|
|
xhv = (XPVHV*)SvANY(hv); |
404
|
5146516810
|
100
|
|
|
|
if (SvMAGICAL(hv)) { |
405
|
669669244
|
100
|
|
|
|
if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) { |
|
|
100
|
|
|
|
|
406
|
659528400
|
100
|
|
|
|
if (mg_find((const SV *)hv, PERL_MAGIC_tied) |
407
|
659140809
|
50
|
|
|
|
|| SvGMAGICAL((const SV *)hv)) |
408
|
|
|
|
|
|
{ |
409
|
|
|
|
|
|
/* FIXME should be able to skimp on the HE/HEK here when |
410
|
|
|
|
|
|
HV_FETCH_JUST_SV is true. */ |
411
|
387591
|
100
|
|
|
|
if (!keysv) { |
412
|
44
|
50
|
|
|
|
keysv = newSVpvn_utf8(key, klen, is_utf8); |
413
|
|
|
|
|
|
} else { |
414
|
387547
|
|
|
|
|
keysv = newSVsv(keysv); |
415
|
|
|
|
|
|
} |
416
|
387591
|
|
|
|
|
sv = sv_newmortal(); |
417
|
387591
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), sv, (char *)keysv, HEf_SVKEY); |
418
|
|
|
|
|
|
|
419
|
|
|
|
|
|
/* grab a fake HE/HEK pair from the pool or make a new one */ |
420
|
387591
|
|
|
|
|
entry = PL_hv_fetch_ent_mh; |
421
|
387591
|
100
|
|
|
|
if (entry) |
422
|
358362
|
|
|
|
|
PL_hv_fetch_ent_mh = HeNEXT(entry); |
423
|
|
|
|
|
|
else { |
424
|
|
|
|
|
|
char *k; |
425
|
29229
|
|
|
|
|
entry = new_HE(); |
426
|
29229
|
|
|
|
|
Newx(k, HEK_BASESIZE + sizeof(const SV *), char); |
427
|
29229
|
|
|
|
|
HeKEY_hek(entry) = (HEK*)k; |
428
|
|
|
|
|
|
} |
429
|
387591
|
|
|
|
|
HeNEXT(entry) = NULL; |
430
|
387591
|
|
|
|
|
HeSVKEY_set(entry, keysv); |
431
|
387591
|
|
|
|
|
HeVAL(entry) = sv; |
432
|
387591
|
|
|
|
|
sv_upgrade(sv, SVt_PVLV); |
433
|
387591
|
|
|
|
|
LvTYPE(sv) = 'T'; |
434
|
|
|
|
|
|
/* so we can free entry when freeing sv */ |
435
|
387591
|
|
|
|
|
LvTARG(sv) = MUTABLE_SV(entry); |
436
|
|
|
|
|
|
|
437
|
|
|
|
|
|
/* XXX remove at some point? */ |
438
|
387591
|
50
|
|
|
|
if (flags & HVhek_FREEKEY) |
439
|
0
|
|
|
|
|
Safefree(key); |
440
|
|
|
|
|
|
|
441
|
387591
|
100
|
|
|
|
if (return_svp) { |
442
|
34
|
50
|
|
|
|
return entry ? (void *) &HeVAL(entry) : NULL; |
443
|
|
|
|
|
|
} |
444
|
|
|
|
|
|
return (void *) entry; |
445
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
#ifdef ENV_IS_CASELESS |
447
|
|
|
|
|
|
else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { |
448
|
|
|
|
|
|
U32 i; |
449
|
|
|
|
|
|
for (i = 0; i < klen; ++i) |
450
|
|
|
|
|
|
if (isLOWER(key[i])) { |
451
|
|
|
|
|
|
/* Would be nice if we had a routine to do the |
452
|
|
|
|
|
|
copy and upercase in a single pass through. */ |
453
|
|
|
|
|
|
const char * const nkey = strupr(savepvn(key,klen)); |
454
|
|
|
|
|
|
/* Note that this fetch is for nkey (the uppercased |
455
|
|
|
|
|
|
key) whereas the store is for key (the original) */ |
456
|
|
|
|
|
|
void *result = hv_common(hv, NULL, nkey, klen, |
457
|
|
|
|
|
|
HVhek_FREEKEY, /* free nkey */ |
458
|
|
|
|
|
|
0 /* non-LVAL fetch */ |
459
|
|
|
|
|
|
| HV_DISABLE_UVAR_XKEY |
460
|
|
|
|
|
|
| return_svp, |
461
|
|
|
|
|
|
NULL /* no value */, |
462
|
|
|
|
|
|
0 /* compute hash */); |
463
|
|
|
|
|
|
if (!result && (action & HV_FETCH_LVALUE)) { |
464
|
|
|
|
|
|
/* This call will free key if necessary. |
465
|
|
|
|
|
|
Do it this way to encourage compiler to tail |
466
|
|
|
|
|
|
call optimise. */ |
467
|
|
|
|
|
|
result = hv_common(hv, keysv, key, klen, flags, |
468
|
|
|
|
|
|
HV_FETCH_ISSTORE |
469
|
|
|
|
|
|
| HV_DISABLE_UVAR_XKEY |
470
|
|
|
|
|
|
| return_svp, |
471
|
|
|
|
|
|
newSV(0), hash); |
472
|
|
|
|
|
|
} else { |
473
|
|
|
|
|
|
if (flags & HVhek_FREEKEY) |
474
|
|
|
|
|
|
Safefree(key); |
475
|
|
|
|
|
|
} |
476
|
|
|
|
|
|
return result; |
477
|
|
|
|
|
|
} |
478
|
|
|
|
|
|
} |
479
|
|
|
|
|
|
#endif |
480
|
|
|
|
|
|
} /* ISFETCH */ |
481
|
10140844
|
100
|
|
|
|
else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) { |
|
|
100
|
|
|
|
|
482
|
3139418
|
100
|
|
|
|
if (mg_find((const SV *)hv, PERL_MAGIC_tied) |
483
|
3050712
|
50
|
|
|
|
|| SvGMAGICAL((const SV *)hv)) { |
484
|
|
|
|
|
|
/* I don't understand why hv_exists_ent has svret and sv, |
485
|
|
|
|
|
|
whereas hv_exists only had one. */ |
486
|
88706
|
|
|
|
|
SV * const svret = sv_newmortal(); |
487
|
88706
|
|
|
|
|
sv = sv_newmortal(); |
488
|
|
|
|
|
|
|
489
|
88706
|
50
|
|
|
|
if (keysv || is_utf8) { |
|
|
0
|
|
|
|
|
490
|
88706
|
50
|
|
|
|
if (!keysv) { |
491
|
0
|
|
|
|
|
keysv = newSVpvn_utf8(key, klen, TRUE); |
492
|
|
|
|
|
|
} else { |
493
|
88706
|
|
|
|
|
keysv = newSVsv(keysv); |
494
|
|
|
|
|
|
} |
495
|
88706
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY); |
496
|
|
|
|
|
|
} else { |
497
|
0
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), sv, key, klen); |
498
|
|
|
|
|
|
} |
499
|
88706
|
50
|
|
|
|
if (flags & HVhek_FREEKEY) |
500
|
0
|
|
|
|
|
Safefree(key); |
501
|
88706
|
|
|
|
|
magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem)); |
502
|
|
|
|
|
|
/* This cast somewhat evil, but I'm merely using NULL/ |
503
|
|
|
|
|
|
not NULL to return the boolean exists. |
504
|
|
|
|
|
|
And I know hv is not NULL. */ |
505
|
88706
|
50
|
|
|
|
return SvTRUE(svret) ? (void *)hv : NULL; |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
0
|
|
|
|
|
506
|
|
|
|
|
|
} |
507
|
|
|
|
|
|
#ifdef ENV_IS_CASELESS |
508
|
|
|
|
|
|
else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { |
509
|
|
|
|
|
|
/* XXX This code isn't UTF8 clean. */ |
510
|
|
|
|
|
|
char * const keysave = (char * const)key; |
511
|
|
|
|
|
|
/* Will need to free this, so set FREEKEY flag. */ |
512
|
|
|
|
|
|
key = savepvn(key,klen); |
513
|
|
|
|
|
|
key = (const char*)strupr((char*)key); |
514
|
|
|
|
|
|
is_utf8 = FALSE; |
515
|
|
|
|
|
|
hash = 0; |
516
|
|
|
|
|
|
keysv = 0; |
517
|
|
|
|
|
|
|
518
|
|
|
|
|
|
if (flags & HVhek_FREEKEY) { |
519
|
|
|
|
|
|
Safefree(keysave); |
520
|
|
|
|
|
|
} |
521
|
|
|
|
|
|
flags |= HVhek_FREEKEY; |
522
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
#endif |
524
|
|
|
|
|
|
} /* ISEXISTS */ |
525
|
7001426
|
100
|
|
|
|
else if (action & HV_FETCH_ISSTORE) { |
526
|
|
|
|
|
|
bool needs_copy; |
527
|
|
|
|
|
|
bool needs_store; |
528
|
|
|
|
|
|
hv_magic_check (hv, &needs_copy, &needs_store); |
529
|
6960950
|
100
|
|
|
|
if (needs_copy) { |
530
|
6189062
|
|
|
|
|
const bool save_taint = TAINT_get; |
531
|
6189062
|
100
|
|
|
|
if (keysv || is_utf8) { |
|
|
50
|
|
|
|
|
532
|
3358952
|
50
|
|
|
|
if (!keysv) { |
533
|
0
|
|
|
|
|
keysv = newSVpvn_utf8(key, klen, TRUE); |
534
|
|
|
|
|
|
} |
535
|
3358952
|
100
|
|
|
|
if (TAINTING_get) |
536
|
7294
|
50
|
|
|
|
TAINT_set(SvTAINTED(keysv)); |
|
|
0
|
|
|
|
|
537
|
3358952
|
|
|
|
|
keysv = sv_2mortal(newSVsv(keysv)); |
538
|
3358952
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY); |
539
|
|
|
|
|
|
} else { |
540
|
2830110
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), val, key, klen); |
541
|
|
|
|
|
|
} |
542
|
|
|
|
|
|
|
543
|
6189062
|
100
|
|
|
|
TAINT_IF(save_taint); |
544
|
|
|
|
|
|
#ifdef NO_TAINT_SUPPORT |
545
|
|
|
|
|
|
PERL_UNUSED_VAR(save_taint); |
546
|
|
|
|
|
|
#endif |
547
|
6189062
|
100
|
|
|
|
if (!needs_store) { |
548
|
52
|
50
|
|
|
|
if (flags & HVhek_FREEKEY) |
549
|
0
|
|
|
|
|
Safefree(key); |
550
|
|
|
|
|
|
return NULL; |
551
|
|
|
|
|
|
} |
552
|
|
|
|
|
|
#ifdef ENV_IS_CASELESS |
553
|
|
|
|
|
|
else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { |
554
|
|
|
|
|
|
/* XXX This code isn't UTF8 clean. */ |
555
|
|
|
|
|
|
const char *keysave = key; |
556
|
|
|
|
|
|
/* Will need to free this, so set FREEKEY flag. */ |
557
|
|
|
|
|
|
key = savepvn(key,klen); |
558
|
|
|
|
|
|
key = (const char*)strupr((char*)key); |
559
|
|
|
|
|
|
is_utf8 = FALSE; |
560
|
|
|
|
|
|
hash = 0; |
561
|
|
|
|
|
|
keysv = 0; |
562
|
|
|
|
|
|
|
563
|
|
|
|
|
|
if (flags & HVhek_FREEKEY) { |
564
|
|
|
|
|
|
Safefree(keysave); |
565
|
|
|
|
|
|
} |
566
|
|
|
|
|
|
flags |= HVhek_FREEKEY; |
567
|
|
|
|
|
|
} |
568
|
|
|
|
|
|
#endif |
569
|
|
|
|
|
|
} |
570
|
|
|
|
|
|
} /* ISSTORE */ |
571
|
|
|
|
|
|
} /* SvMAGICAL */ |
572
|
|
|
|
|
|
|
573
|
5146040461
|
100
|
|
|
|
if (!HvARRAY(hv)) { |
574
|
130994191
|
100
|
|
|
|
if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE)) |
575
|
|
|
|
|
|
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */ |
576
|
|
|
|
|
|
|| (SvRMAGICAL((const SV *)hv) |
577
|
|
|
|
|
|
&& mg_find((const SV *)hv, PERL_MAGIC_env)) |
578
|
|
|
|
|
|
#endif |
579
|
|
|
|
|
|
) { |
580
|
|
|
|
|
|
char *array; |
581
|
101942635
|
|
|
|
|
Newxz(array, |
582
|
|
|
|
|
|
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), |
583
|
|
|
|
|
|
char); |
584
|
101942635
|
|
|
|
|
HvARRAY(hv) = (HE**)array; |
585
|
|
|
|
|
|
} |
586
|
|
|
|
|
|
#ifdef DYNAMIC_ENV_FETCH |
587
|
|
|
|
|
|
else if (action & HV_FETCH_ISEXISTS) { |
588
|
|
|
|
|
|
/* for an %ENV exists, if we do an insert it's by a recursive |
589
|
|
|
|
|
|
store call, so avoid creating HvARRAY(hv) right now. */ |
590
|
|
|
|
|
|
} |
591
|
|
|
|
|
|
#endif |
592
|
|
|
|
|
|
else { |
593
|
|
|
|
|
|
/* XXX remove at some point? */ |
594
|
29051556
|
50
|
|
|
|
if (flags & HVhek_FREEKEY) |
595
|
0
|
|
|
|
|
Safefree(key); |
596
|
|
|
|
|
|
|
597
|
|
|
|
|
|
return NULL; |
598
|
|
|
|
|
|
} |
599
|
|
|
|
|
|
} |
600
|
|
|
|
|
|
|
601
|
5116988905
|
100
|
|
|
|
if (is_utf8 && !(flags & HVhek_KEYCANONICAL)) { |
|
|
100
|
|
|
|
|
602
|
|
|
|
|
|
char * const keysave = (char *)key; |
603
|
1533420
|
|
|
|
|
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); |
604
|
1533420
|
100
|
|
|
|
if (is_utf8) |
605
|
1411274
|
|
|
|
|
flags |= HVhek_UTF8; |
606
|
|
|
|
|
|
else |
607
|
122146
|
|
|
|
|
flags &= ~HVhek_UTF8; |
608
|
1533420
|
100
|
|
|
|
if (key != keysave) { |
609
|
122146
|
50
|
|
|
|
if (flags & HVhek_FREEKEY) |
610
|
0
|
|
|
|
|
Safefree(keysave); |
611
|
122146
|
|
|
|
|
flags |= HVhek_WASUTF8 | HVhek_FREEKEY; |
612
|
|
|
|
|
|
/* If the caller calculated a hash, it was on the sequence of |
613
|
|
|
|
|
|
octets that are the UTF-8 form. We've now changed the sequence |
614
|
|
|
|
|
|
of octets stored to that of the equivalent byte representation, |
615
|
|
|
|
|
|
so the hash we need is different. */ |
616
|
|
|
|
|
|
hash = 0; |
617
|
|
|
|
|
|
} |
618
|
|
|
|
|
|
} |
619
|
|
|
|
|
|
|
620
|
5116988905
|
100
|
|
|
|
if (!hash) { |
621
|
4491402563
|
100
|
|
|
|
if (keysv && (SvIsCOW_shared_hash(keysv))) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
622
|
361659333
|
|
|
|
|
hash = SvSHARED_HASH(keysv); |
623
|
|
|
|
|
|
else |
624
|
4129743230
|
|
|
|
|
PERL_HASH(hash, key, klen); |
625
|
|
|
|
|
|
} |
626
|
|
|
|
|
|
|
627
|
5116988905
|
|
|
|
|
masked_flags = (flags & HVhek_MASK); |
628
|
|
|
|
|
|
|
629
|
|
|
|
|
|
#ifdef DYNAMIC_ENV_FETCH |
630
|
|
|
|
|
|
if (!HvARRAY(hv)) entry = NULL; |
631
|
|
|
|
|
|
else |
632
|
|
|
|
|
|
#endif |
633
|
|
|
|
|
|
{ |
634
|
5116988905
|
|
|
|
|
entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; |
635
|
|
|
|
|
|
} |
636
|
7223932332
|
100
|
|
|
|
for (; entry; entry = HeNEXT(entry)) { |
637
|
5544798422
|
100
|
|
|
|
if (HeHASH(entry) != hash) /* strings can't be equal */ |
638
|
2106942339
|
|
|
|
|
continue; |
639
|
3437856083
|
100
|
|
|
|
if (HeKLEN(entry) != (I32)klen) |
640
|
8
|
|
|
|
|
continue; |
641
|
3437856075
|
100
|
|
|
|
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ |
|
|
100
|
|
|
|
|
642
|
608
|
|
|
|
|
continue; |
643
|
3437855467
|
100
|
|
|
|
if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) |
644
|
472
|
|
|
|
|
continue; |
645
|
|
|
|
|
|
|
646
|
3437854995
|
100
|
|
|
|
if (action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE)) { |
647
|
1766248462
|
100
|
|
|
|
if (HeKFLAGS(entry) != masked_flags) { |
648
|
|
|
|
|
|
/* We match if HVhek_UTF8 bit in our flags and hash key's |
649
|
|
|
|
|
|
match. But if entry was set previously with HVhek_WASUTF8 |
650
|
|
|
|
|
|
and key now doesn't (or vice versa) then we should change |
651
|
|
|
|
|
|
the key's flag, as this is assignment. */ |
652
|
9818
|
50
|
|
|
|
if (HvSHAREKEYS(hv)) { |
653
|
|
|
|
|
|
/* Need to swap the key we have for a key with the flags we |
654
|
|
|
|
|
|
need. As keys are shared we can't just write to the |
655
|
|
|
|
|
|
flag, so we share the new one, unshare the old one. */ |
656
|
9818
|
|
|
|
|
HEK * const new_hek = share_hek_flags(key, klen, hash, |
657
|
|
|
|
|
|
masked_flags); |
658
|
9818
|
|
|
|
|
unshare_hek (HeKEY_hek(entry)); |
659
|
9818
|
|
|
|
|
HeKEY_hek(entry) = new_hek; |
660
|
|
|
|
|
|
} |
661
|
0
|
0
|
|
|
|
else if (hv == PL_strtab) { |
662
|
|
|
|
|
|
/* PL_strtab is usually the only hash without HvSHAREKEYS, |
663
|
|
|
|
|
|
so putting this test here is cheap */ |
664
|
0
|
0
|
|
|
|
if (flags & HVhek_FREEKEY) |
665
|
0
|
|
|
|
|
Safefree(key); |
666
|
0
|
0
|
|
|
|
Perl_croak(aTHX_ S_strtab_error, |
667
|
0
|
|
|
|
|
action & HV_FETCH_LVALUE ? "fetch" : "store"); |
668
|
|
|
|
|
|
} |
669
|
|
|
|
|
|
else |
670
|
0
|
|
|
|
|
HeKFLAGS(entry) = masked_flags; |
671
|
9818
|
100
|
|
|
|
if (masked_flags & HVhek_ENABLEHVKFLAGS) |
672
|
6292
|
|
|
|
|
HvHASKFLAGS_on(hv); |
673
|
|
|
|
|
|
} |
674
|
1766248462
|
100
|
|
|
|
if (HeVAL(entry) == &PL_sv_placeholder) { |
675
|
|
|
|
|
|
/* yes, can store into placeholder slot */ |
676
|
20556
|
100
|
|
|
|
if (action & HV_FETCH_LVALUE) { |
677
|
10276
|
50
|
|
|
|
if (SvMAGICAL(hv)) { |
678
|
|
|
|
|
|
/* This preserves behaviour with the old hv_fetch |
679
|
|
|
|
|
|
implementation which at this point would bail out |
680
|
|
|
|
|
|
with a break; (at "if we find a placeholder, we |
681
|
|
|
|
|
|
pretend we haven't found anything") |
682
|
|
|
|
|
|
|
683
|
|
|
|
|
|
That break mean that if a placeholder were found, it |
684
|
|
|
|
|
|
caused a call into hv_store, which in turn would |
685
|
|
|
|
|
|
check magic, and if there is no magic end up pretty |
686
|
|
|
|
|
|
much back at this point (in hv_store's code). */ |
687
|
|
|
|
|
|
break; |
688
|
|
|
|
|
|
} |
689
|
|
|
|
|
|
/* LVAL fetch which actually needs a store. */ |
690
|
0
|
|
|
|
|
val = newSV(0); |
691
|
0
|
|
|
|
|
HvPLACEHOLDERS(hv)--; |
692
|
|
|
|
|
|
} else { |
693
|
|
|
|
|
|
/* store */ |
694
|
10280
|
50
|
|
|
|
if (val != &PL_sv_placeholder) |
695
|
10280
|
|
|
|
|
HvPLACEHOLDERS(hv)--; |
696
|
|
|
|
|
|
} |
697
|
10280
|
|
|
|
|
HeVAL(entry) = val; |
698
|
1766227906
|
100
|
|
|
|
} else if (action & HV_FETCH_ISSTORE) { |
699
|
513487
|
|
|
|
|
SvREFCNT_dec(HeVAL(entry)); |
700
|
513487
|
|
|
|
|
HeVAL(entry) = val; |
701
|
|
|
|
|
|
} |
702
|
1671606533
|
100
|
|
|
|
} else if (HeVAL(entry) == &PL_sv_placeholder) { |
703
|
|
|
|
|
|
/* if we find a placeholder, we pretend we haven't found |
704
|
|
|
|
|
|
anything */ |
705
|
|
|
|
|
|
break; |
706
|
|
|
|
|
|
} |
707
|
3437844683
|
100
|
|
|
|
if (flags & HVhek_FREEKEY) |
708
|
100364
|
|
|
|
|
Safefree(key); |
709
|
3437844683
|
100
|
|
|
|
if (return_svp) { |
710
|
2438132873
|
50
|
|
|
|
return entry ? (void *) &HeVAL(entry) : NULL; |
711
|
|
|
|
|
|
} |
712
|
|
|
|
|
|
return entry; |
713
|
|
|
|
|
|
} |
714
|
|
|
|
|
|
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */ |
715
|
|
|
|
|
|
if (!(action & HV_FETCH_ISSTORE) |
716
|
|
|
|
|
|
&& SvRMAGICAL((const SV *)hv) |
717
|
|
|
|
|
|
&& mg_find((const SV *)hv, PERL_MAGIC_env)) { |
718
|
|
|
|
|
|
unsigned long len; |
719
|
|
|
|
|
|
const char * const env = PerlEnv_ENVgetenv_len(key,&len); |
720
|
|
|
|
|
|
if (env) { |
721
|
|
|
|
|
|
sv = newSVpvn(env,len); |
722
|
|
|
|
|
|
SvTAINTED_on(sv); |
723
|
|
|
|
|
|
return hv_common(hv, keysv, key, klen, flags, |
724
|
|
|
|
|
|
HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, |
725
|
|
|
|
|
|
sv, hash); |
726
|
|
|
|
|
|
} |
727
|
|
|
|
|
|
} |
728
|
|
|
|
|
|
#endif |
729
|
|
|
|
|
|
|
730
|
1679144222
|
100
|
|
|
|
if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
731
|
242
|
|
|
|
|
hv_notallowed(flags, key, klen, |
732
|
|
|
|
|
|
"Attempt to access disallowed key '%"SVf"' in" |
733
|
|
|
|
|
|
" a restricted hash"); |
734
|
|
|
|
|
|
} |
735
|
1679143980
|
100
|
|
|
|
if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) { |
736
|
|
|
|
|
|
/* Not doing some form of store, so return failure. */ |
737
|
1166548589
|
100
|
|
|
|
if (flags & HVhek_FREEKEY) |
738
|
15878
|
|
|
|
|
Safefree(key); |
739
|
|
|
|
|
|
return NULL; |
740
|
|
|
|
|
|
} |
741
|
512595391
|
100
|
|
|
|
if (action & HV_FETCH_LVALUE) { |
742
|
153706366
|
100
|
|
|
|
val = action & HV_FETCH_EMPTY_HE ? NULL : newSV(0); |
743
|
153706366
|
100
|
|
|
|
if (SvMAGICAL(hv)) { |
744
|
|
|
|
|
|
/* At this point the old hv_fetch code would call to hv_store, |
745
|
|
|
|
|
|
which in turn might do some tied magic. So we need to make that |
746
|
|
|
|
|
|
magic check happen. */ |
747
|
|
|
|
|
|
/* gonna assign to this, so it better be there */ |
748
|
|
|
|
|
|
/* If a fetch-as-store fails on the fetch, then the action is to |
749
|
|
|
|
|
|
recurse once into "hv_store". If we didn't do this, then that |
750
|
|
|
|
|
|
recursive call would call the key conversion routine again. |
751
|
|
|
|
|
|
However, as we replace the original key with the converted |
752
|
|
|
|
|
|
key, this would result in a double conversion, which would show |
753
|
|
|
|
|
|
up as a bug if the conversion routine is not idempotent. |
754
|
|
|
|
|
|
Hence the use of HV_DISABLE_UVAR_XKEY. */ |
755
|
4880048
|
|
|
|
|
return hv_common(hv, keysv, key, klen, flags, |
756
|
|
|
|
|
|
HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp, |
757
|
|
|
|
|
|
val, hash); |
758
|
|
|
|
|
|
/* XXX Surely that could leak if the fetch-was-store fails? |
759
|
|
|
|
|
|
Just like the hv_fetch. */ |
760
|
|
|
|
|
|
} |
761
|
|
|
|
|
|
} |
762
|
|
|
|
|
|
|
763
|
|
|
|
|
|
/* Welcome to hv_store... */ |
764
|
|
|
|
|
|
|
765
|
507715343
|
50
|
|
|
|
if (!HvARRAY(hv)) { |
766
|
|
|
|
|
|
/* Not sure if we can get here. I think the only case of oentry being |
767
|
|
|
|
|
|
NULL is for %ENV with dynamic env fetch. But that should disappear |
768
|
|
|
|
|
|
with magic in the previous code. */ |
769
|
|
|
|
|
|
char *array; |
770
|
0
|
|
|
|
|
Newxz(array, |
771
|
|
|
|
|
|
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */), |
772
|
|
|
|
|
|
char); |
773
|
0
|
|
|
|
|
HvARRAY(hv) = (HE**)array; |
774
|
|
|
|
|
|
} |
775
|
|
|
|
|
|
|
776
|
507715343
|
|
|
|
|
oentry = &(HvARRAY(hv))[hash & (I32) xhv->xhv_max]; |
777
|
|
|
|
|
|
|
778
|
507715343
|
|
|
|
|
entry = new_HE(); |
779
|
|
|
|
|
|
/* share_hek_flags will do the free for us. This might be considered |
780
|
|
|
|
|
|
bad API design. */ |
781
|
507715343
|
50
|
|
|
|
if (HvSHAREKEYS(hv)) |
782
|
507715343
|
|
|
|
|
HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags); |
783
|
0
|
0
|
|
|
|
else if (hv == PL_strtab) { |
784
|
|
|
|
|
|
/* PL_strtab is usually the only hash without HvSHAREKEYS, so putting |
785
|
|
|
|
|
|
this test here is cheap */ |
786
|
0
|
0
|
|
|
|
if (flags & HVhek_FREEKEY) |
787
|
0
|
|
|
|
|
Safefree(key); |
788
|
0
|
0
|
|
|
|
Perl_croak(aTHX_ S_strtab_error, |
789
|
0
|
|
|
|
|
action & HV_FETCH_LVALUE ? "fetch" : "store"); |
790
|
|
|
|
|
|
} |
791
|
|
|
|
|
|
else /* gotta do the real thing */ |
792
|
0
|
|
|
|
|
HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags); |
793
|
507715343
|
|
|
|
|
HeVAL(entry) = val; |
794
|
|
|
|
|
|
|
795
|
507715343
|
100
|
|
|
|
if (!*oentry && SvOOK(hv)) { |
|
|
100
|
|
|
|
|
796
|
|
|
|
|
|
/* initial entry, and aux struct present. */ |
797
|
24044302
|
|
|
|
|
struct xpvhv_aux *const aux = HvAUX(hv); |
798
|
24044302
|
100
|
|
|
|
if (aux->xhv_fill_lazy) |
799
|
21686
|
|
|
|
|
++aux->xhv_fill_lazy; |
800
|
|
|
|
|
|
} |
801
|
|
|
|
|
|
|
802
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
803
|
|
|
|
|
|
/* This logic semi-randomizes the insert order in a bucket. |
804
|
|
|
|
|
|
* Either we insert into the top, or the slot below the top, |
805
|
|
|
|
|
|
* making it harder to see if there is a collision. We also |
806
|
|
|
|
|
|
* reset the iterator randomizer if there is one. |
807
|
|
|
|
|
|
*/ |
808
|
507715343
|
100
|
|
|
|
if ( *oentry && PL_HASH_RAND_BITS_ENABLED) { |
|
|
100
|
|
|
|
|
809
|
136363816
|
|
|
|
|
PL_hash_rand_bits++; |
810
|
136363816
|
|
|
|
|
PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1); |
811
|
136363816
|
100
|
|
|
|
if ( PL_hash_rand_bits & 1 ) { |
812
|
68147155
|
|
|
|
|
HeNEXT(entry) = HeNEXT(*oentry); |
813
|
68147155
|
|
|
|
|
HeNEXT(*oentry) = entry; |
814
|
|
|
|
|
|
} else { |
815
|
68216661
|
|
|
|
|
HeNEXT(entry) = *oentry; |
816
|
68216661
|
|
|
|
|
*oentry = entry; |
817
|
|
|
|
|
|
} |
818
|
|
|
|
|
|
} else |
819
|
|
|
|
|
|
#endif |
820
|
|
|
|
|
|
{ |
821
|
371351527
|
|
|
|
|
HeNEXT(entry) = *oentry; |
822
|
371351527
|
|
|
|
|
*oentry = entry; |
823
|
|
|
|
|
|
} |
824
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
825
|
507715343
|
100
|
|
|
|
if (SvOOK(hv)) { |
826
|
|
|
|
|
|
/* Currently this makes various tests warn in annoying ways. |
827
|
|
|
|
|
|
* So Silenced for now. - Yves | bogus end of comment =>* / |
828
|
|
|
|
|
|
if (HvAUX(hv)->xhv_riter != -1) { |
829
|
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), |
830
|
|
|
|
|
|
"[TESTING] Inserting into a hash during each() traversal results in undefined behavior" |
831
|
|
|
|
|
|
pTHX__FORMAT |
832
|
|
|
|
|
|
pTHX__VALUE); |
833
|
|
|
|
|
|
} |
834
|
|
|
|
|
|
*/ |
835
|
41127067
|
100
|
|
|
|
if (PL_HASH_RAND_BITS_ENABLED) { |
836
|
41126667
|
100
|
|
|
|
if (PL_HASH_RAND_BITS_ENABLED == 1) |
837
|
41125667
|
|
|
|
|
PL_hash_rand_bits += (PTRV)entry + 1; /* we don't bother to use ptr_hash here */ |
838
|
41126667
|
|
|
|
|
PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1); |
839
|
|
|
|
|
|
} |
840
|
41127067
|
|
|
|
|
HvAUX(hv)->xhv_rand= (U32)PL_hash_rand_bits; |
841
|
|
|
|
|
|
} |
842
|
|
|
|
|
|
#endif |
843
|
|
|
|
|
|
|
844
|
507715343
|
100
|
|
|
|
if (val == &PL_sv_placeholder) |
845
|
10260
|
|
|
|
|
HvPLACEHOLDERS(hv)++; |
846
|
507715343
|
100
|
|
|
|
if (masked_flags & HVhek_ENABLEHVKFLAGS) |
847
|
605974
|
|
|
|
|
HvHASKFLAGS_on(hv); |
848
|
|
|
|
|
|
|
849
|
507715343
|
|
|
|
|
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ |
850
|
507715343
|
100
|
|
|
|
if ( DO_HSPLIT(xhv) ) { |
851
|
9209010
|
|
|
|
|
const STRLEN oldsize = xhv->xhv_max + 1; |
852
|
9209010
|
100
|
|
|
|
const U32 items = (U32)HvPLACEHOLDERS_get(hv); |
853
|
|
|
|
|
|
|
854
|
9209010
|
50
|
|
|
|
if (items /* hash has placeholders */ |
855
|
0
|
0
|
|
|
|
&& !SvREADONLY(hv) /* but is not a restricted hash */) { |
856
|
|
|
|
|
|
/* If this hash previously was a "restricted hash" and had |
857
|
|
|
|
|
|
placeholders, but the "restricted" flag has been turned off, |
858
|
|
|
|
|
|
then the placeholders no longer serve any useful purpose. |
859
|
|
|
|
|
|
However, they have the downsides of taking up RAM, and adding |
860
|
|
|
|
|
|
extra steps when finding used values. It's safe to clear them |
861
|
|
|
|
|
|
at this point, even though Storable rebuilds restricted hashes by |
862
|
|
|
|
|
|
putting in all the placeholders (first) before turning on the |
863
|
|
|
|
|
|
readonly flag, because Storable always pre-splits the hash. |
864
|
|
|
|
|
|
If we're lucky, then we may clear sufficient placeholders to |
865
|
|
|
|
|
|
avoid needing to split the hash at all. */ |
866
|
0
|
|
|
|
|
clear_placeholders(hv, items); |
867
|
0
|
0
|
|
|
|
if (DO_HSPLIT(xhv)) |
868
|
0
|
|
|
|
|
hsplit(hv, oldsize, oldsize * 2); |
869
|
|
|
|
|
|
} else |
870
|
9209010
|
|
|
|
|
hsplit(hv, oldsize, oldsize * 2); |
871
|
|
|
|
|
|
} |
872
|
|
|
|
|
|
|
873
|
507715343
|
100
|
|
|
|
if (return_svp) { |
874
|
2765846504
|
50
|
|
|
|
return entry ? (void *) &HeVAL(entry) : NULL; |
875
|
|
|
|
|
|
} |
876
|
|
|
|
|
|
return (void *) entry; |
877
|
|
|
|
|
|
} |
878
|
|
|
|
|
|
|
879
|
|
|
|
|
|
STATIC void |
880
|
|
|
|
|
|
S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store) |
881
|
|
|
|
|
|
{ |
882
|
10036538
|
|
|
|
|
const MAGIC *mg = SvMAGIC(hv); |
883
|
|
|
|
|
|
|
884
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_MAGIC_CHECK; |
885
|
|
|
|
|
|
|
886
|
|
|
|
|
|
*needs_copy = FALSE; |
887
|
|
|
|
|
|
*needs_store = TRUE; |
888
|
20075882
|
100
|
|
|
|
while (mg) { |
|
|
100
|
|
|
|
|
889
|
10040934
|
100
|
|
|
|
if (isUPPER(mg->mg_type)) { |
|
|
100
|
|
|
|
|
890
|
|
|
|
|
|
*needs_copy = TRUE; |
891
|
9210584
|
100
|
|
|
|
if (mg->mg_type == PERL_MAGIC_tied) { |
|
|
100
|
|
|
|
|
892
|
|
|
|
|
|
*needs_store = FALSE; |
893
|
|
|
|
|
|
return; /* We've set all there is to set. */ |
894
|
|
|
|
|
|
} |
895
|
|
|
|
|
|
} |
896
|
10039344
|
|
|
|
|
mg = mg->mg_moremagic; |
897
|
|
|
|
|
|
} |
898
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
900
|
|
|
|
|
|
/* |
901
|
|
|
|
|
|
=for apidoc hv_scalar |
902
|
|
|
|
|
|
|
903
|
|
|
|
|
|
Evaluates the hash in scalar context and returns the result. Handles magic when the hash is tied. |
904
|
|
|
|
|
|
|
905
|
|
|
|
|
|
=cut |
906
|
|
|
|
|
|
*/ |
907
|
|
|
|
|
|
|
908
|
|
|
|
|
|
SV * |
909
|
111315
|
|
|
|
|
Perl_hv_scalar(pTHX_ HV *hv) |
910
|
|
|
|
|
|
{ |
911
|
|
|
|
|
|
SV *sv; |
912
|
|
|
|
|
|
|
913
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_SCALAR; |
914
|
|
|
|
|
|
|
915
|
111315
|
100
|
|
|
|
if (SvRMAGICAL(hv)) { |
916
|
82
|
|
|
|
|
MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied); |
917
|
82
|
100
|
|
|
|
if (mg) |
918
|
40
|
|
|
|
|
return magic_scalarpack(hv, mg); |
919
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
921
|
111275
|
|
|
|
|
sv = sv_newmortal(); |
922
|
111275
|
100
|
|
|
|
if (HvTOTALKEYS((const HV *)hv)) |
923
|
161141
|
|
|
|
|
Perl_sv_setpvf(aTHX_ sv, "%ld/%ld", |
924
|
161141
|
|
|
|
|
(long)HvFILL(hv), (long)HvMAX(hv) + 1); |
925
|
|
|
|
|
|
else |
926
|
59381
|
|
|
|
|
sv_setiv(sv, 0); |
927
|
|
|
|
|
|
|
928
|
|
|
|
|
|
return sv; |
929
|
|
|
|
|
|
} |
930
|
|
|
|
|
|
|
931
|
|
|
|
|
|
/* |
932
|
|
|
|
|
|
=for apidoc hv_delete |
933
|
|
|
|
|
|
|
934
|
|
|
|
|
|
Deletes a key/value pair in the hash. The value's SV is removed from |
935
|
|
|
|
|
|
the hash, made mortal, and returned to the caller. The absolute |
936
|
|
|
|
|
|
value of C is the length of the key. If C is negative the |
937
|
|
|
|
|
|
key is assumed to be in UTF-8-encoded Unicode. The C value |
938
|
|
|
|
|
|
will normally be zero; if set to G_DISCARD then NULL will be returned. |
939
|
|
|
|
|
|
NULL will also be returned if the key is not found. |
940
|
|
|
|
|
|
|
941
|
|
|
|
|
|
=for apidoc hv_delete_ent |
942
|
|
|
|
|
|
|
943
|
|
|
|
|
|
Deletes a key/value pair in the hash. The value SV is removed from the hash, |
944
|
|
|
|
|
|
made mortal, and returned to the caller. The C value will normally be |
945
|
|
|
|
|
|
zero; if set to G_DISCARD then NULL will be returned. NULL will also be |
946
|
|
|
|
|
|
returned if the key is not found. C can be a valid precomputed hash |
947
|
|
|
|
|
|
value, or 0 to ask for it to be computed. |
948
|
|
|
|
|
|
|
949
|
|
|
|
|
|
=cut |
950
|
|
|
|
|
|
*/ |
951
|
|
|
|
|
|
|
952
|
|
|
|
|
|
STATIC SV * |
953
|
20758347
|
|
|
|
|
S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen, |
954
|
|
|
|
|
|
int k_flags, I32 d_flags, U32 hash) |
955
|
|
|
|
|
|
{ |
956
|
|
|
|
|
|
dVAR; |
957
|
|
|
|
|
|
XPVHV* xhv; |
958
|
|
|
|
|
|
HE *entry; |
959
|
|
|
|
|
|
HE **oentry; |
960
|
|
|
|
|
|
HE *const *first_entry; |
961
|
20758347
|
|
|
|
|
bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE; |
962
|
|
|
|
|
|
int masked_flags; |
963
|
|
|
|
|
|
|
964
|
20758347
|
100
|
|
|
|
if (SvRMAGICAL(hv)) { |
965
|
|
|
|
|
|
bool needs_copy; |
966
|
|
|
|
|
|
bool needs_store; |
967
|
|
|
|
|
|
hv_magic_check (hv, &needs_copy, &needs_store); |
968
|
|
|
|
|
|
|
969
|
3075588
|
100
|
|
|
|
if (needs_copy) { |
970
|
|
|
|
|
|
SV *sv; |
971
|
3021522
|
|
|
|
|
entry = (HE *) hv_common(hv, keysv, key, klen, |
972
|
|
|
|
|
|
k_flags & ~HVhek_FREEKEY, |
973
|
|
|
|
|
|
HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY, |
974
|
|
|
|
|
|
NULL, hash); |
975
|
3021522
|
50
|
|
|
|
sv = entry ? HeVAL(entry) : NULL; |
976
|
3021522
|
50
|
|
|
|
if (sv) { |
977
|
3021522
|
50
|
|
|
|
if (SvMAGICAL(sv)) { |
978
|
3021522
|
|
|
|
|
mg_clear(sv); |
979
|
|
|
|
|
|
} |
980
|
3021514
|
100
|
|
|
|
if (!needs_store) { |
981
|
1530
|
50
|
|
|
|
if (mg_find(sv, PERL_MAGIC_tiedelem)) { |
982
|
|
|
|
|
|
/* No longer an element */ |
983
|
1530
|
|
|
|
|
sv_unmagic(sv, PERL_MAGIC_tiedelem); |
984
|
1530
|
|
|
|
|
return sv; |
985
|
|
|
|
|
|
} |
986
|
|
|
|
|
|
return NULL; /* element cannot be deleted */ |
987
|
|
|
|
|
|
} |
988
|
|
|
|
|
|
#ifdef ENV_IS_CASELESS |
989
|
|
|
|
|
|
else if (mg_find((const SV *)hv, PERL_MAGIC_env)) { |
990
|
|
|
|
|
|
/* XXX This code isn't UTF8 clean. */ |
991
|
|
|
|
|
|
keysv = newSVpvn_flags(key, klen, SVs_TEMP); |
992
|
|
|
|
|
|
if (k_flags & HVhek_FREEKEY) { |
993
|
|
|
|
|
|
Safefree(key); |
994
|
|
|
|
|
|
} |
995
|
|
|
|
|
|
key = strupr(SvPVX(keysv)); |
996
|
|
|
|
|
|
is_utf8 = 0; |
997
|
|
|
|
|
|
k_flags = 0; |
998
|
|
|
|
|
|
hash = 0; |
999
|
|
|
|
|
|
} |
1000
|
|
|
|
|
|
#endif |
1001
|
|
|
|
|
|
} |
1002
|
|
|
|
|
|
} |
1003
|
|
|
|
|
|
} |
1004
|
20756809
|
|
|
|
|
xhv = (XPVHV*)SvANY(hv); |
1005
|
20756809
|
100
|
|
|
|
if (!HvARRAY(hv)) |
1006
|
|
|
|
|
|
return NULL; |
1007
|
|
|
|
|
|
|
1008
|
20727201
|
100
|
|
|
|
if (is_utf8 && !(k_flags & HVhek_KEYCANONICAL)) { |
|
|
50
|
|
|
|
|
1009
|
|
|
|
|
|
const char * const keysave = key; |
1010
|
1416
|
|
|
|
|
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8); |
1011
|
|
|
|
|
|
|
1012
|
1416
|
100
|
|
|
|
if (is_utf8) |
1013
|
1380
|
|
|
|
|
k_flags |= HVhek_UTF8; |
1014
|
|
|
|
|
|
else |
1015
|
36
|
|
|
|
|
k_flags &= ~HVhek_UTF8; |
1016
|
1416
|
100
|
|
|
|
if (key != keysave) { |
1017
|
36
|
50
|
|
|
|
if (k_flags & HVhek_FREEKEY) { |
1018
|
|
|
|
|
|
/* This shouldn't happen if our caller does what we expect, |
1019
|
|
|
|
|
|
but strictly the API allows it. */ |
1020
|
0
|
|
|
|
|
Safefree(keysave); |
1021
|
|
|
|
|
|
} |
1022
|
36
|
|
|
|
|
k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY; |
1023
|
|
|
|
|
|
} |
1024
|
1416
|
|
|
|
|
HvHASKFLAGS_on(MUTABLE_SV(hv)); |
1025
|
|
|
|
|
|
} |
1026
|
|
|
|
|
|
|
1027
|
20727201
|
50
|
|
|
|
if (!hash) { |
1028
|
20727201
|
100
|
|
|
|
if (keysv && (SvIsCOW_shared_hash(keysv))) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1029
|
344978
|
|
|
|
|
hash = SvSHARED_HASH(keysv); |
1030
|
|
|
|
|
|
else |
1031
|
20382223
|
|
|
|
|
PERL_HASH(hash, key, klen); |
1032
|
|
|
|
|
|
} |
1033
|
|
|
|
|
|
|
1034
|
20727201
|
|
|
|
|
masked_flags = (k_flags & HVhek_MASK); |
1035
|
|
|
|
|
|
|
1036
|
20727201
|
|
|
|
|
first_entry = oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; |
1037
|
20727201
|
|
|
|
|
entry = *oentry; |
1038
|
25822011
|
100
|
|
|
|
for (; entry; oentry = &HeNEXT(entry), entry = *oentry) { |
1039
|
|
|
|
|
|
SV *sv; |
1040
|
|
|
|
|
|
U8 mro_changes = 0; /* 1 = isa; 2 = package moved */ |
1041
|
|
|
|
|
|
GV *gv = NULL; |
1042
|
|
|
|
|
|
HV *stash = NULL; |
1043
|
|
|
|
|
|
|
1044
|
21103893
|
100
|
|
|
|
if (HeHASH(entry) != hash) /* strings can't be equal */ |
1045
|
5094788
|
|
|
|
|
continue; |
1046
|
16009105
|
50
|
|
|
|
if (HeKLEN(entry) != (I32)klen) |
1047
|
0
|
|
|
|
|
continue; |
1048
|
16009105
|
100
|
|
|
|
if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */ |
|
|
100
|
|
|
|
|
1049
|
22
|
|
|
|
|
continue; |
1050
|
16009083
|
50
|
|
|
|
if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8) |
1051
|
0
|
|
|
|
|
continue; |
1052
|
|
|
|
|
|
|
1053
|
16009083
|
50
|
|
|
|
if (hv == PL_strtab) { |
1054
|
0
|
0
|
|
|
|
if (k_flags & HVhek_FREEKEY) |
1055
|
0
|
|
|
|
|
Safefree(key); |
1056
|
0
|
|
|
|
|
Perl_croak(aTHX_ S_strtab_error, "delete"); |
1057
|
|
|
|
|
|
} |
1058
|
|
|
|
|
|
|
1059
|
|
|
|
|
|
/* if placeholder is here, it's already been deleted.... */ |
1060
|
16009083
|
100
|
|
|
|
if (HeVAL(entry) == &PL_sv_placeholder) { |
1061
|
4
|
50
|
|
|
|
if (k_flags & HVhek_FREEKEY) |
1062
|
0
|
|
|
|
|
Safefree(key); |
1063
|
|
|
|
|
|
return NULL; |
1064
|
|
|
|
|
|
} |
1065
|
16009079
|
100
|
|
|
|
if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1066
|
0
|
|
|
|
|
hv_notallowed(k_flags, key, klen, |
1067
|
|
|
|
|
|
"Attempt to delete readonly key '%"SVf"' from" |
1068
|
|
|
|
|
|
" a restricted hash"); |
1069
|
|
|
|
|
|
} |
1070
|
16009079
|
100
|
|
|
|
if (k_flags & HVhek_FREEKEY) |
1071
|
36
|
|
|
|
|
Safefree(key); |
1072
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
/* If this is a stash and the key ends with ::, then someone is |
1074
|
|
|
|
|
|
* deleting a package. |
1075
|
|
|
|
|
|
*/ |
1076
|
16009079
|
50
|
|
|
|
if (HeVAL(entry) && HvENAME_get(hv)) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1077
|
6120185
|
|
|
|
|
gv = (GV *)HeVAL(entry); |
1078
|
6120185
|
100
|
|
|
|
if (keysv) key = SvPV(keysv, klen); |
|
|
50
|
|
|
|
|
1079
|
6120185
|
100
|
|
|
|
if (( |
1080
|
9124230
|
100
|
|
|
|
(klen > 1 && key[klen-2] == ':' && key[klen-1] == ':') |
|
|
50
|
|
|
|
|
1081
|
6120037
|
100
|
|
|
|
|| |
1082
|
3027163
|
50
|
|
|
|
(klen == 1 && key[0] == ':') |
1083
|
|
|
|
|
|
) |
1084
|
148
|
100
|
|
|
|
&& (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6)) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1085
|
146
|
50
|
|
|
|
&& SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv)) |
|
|
50
|
|
|
|
|
1086
|
146
|
50
|
|
|
|
&& HvENAME_get(stash)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1087
|
|
|
|
|
|
/* A previous version of this code checked that the |
1088
|
|
|
|
|
|
* GV was still in the symbol table by fetching the |
1089
|
|
|
|
|
|
* GV with its name. That is not necessary (and |
1090
|
|
|
|
|
|
* sometimes incorrect), as HvENAME cannot be set |
1091
|
|
|
|
|
|
* on hv if it is not in the symtab. */ |
1092
|
|
|
|
|
|
mro_changes = 2; |
1093
|
|
|
|
|
|
/* Hang on to it for a bit. */ |
1094
|
146
|
|
|
|
|
SvREFCNT_inc_simple_void_NN( |
1095
|
|
|
|
|
|
sv_2mortal((SV *)gv) |
1096
|
|
|
|
|
|
); |
1097
|
|
|
|
|
|
} |
1098
|
6120039
|
100
|
|
|
|
else if (klen == 3 && strnEQ(key, "ISA", 3)) |
|
|
100
|
|
|
|
|
1099
|
|
|
|
|
|
mro_changes = 1; |
1100
|
|
|
|
|
|
} |
1101
|
|
|
|
|
|
|
1102
|
16009079
|
100
|
|
|
|
sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry)); |
1103
|
16009079
|
|
|
|
|
HeVAL(entry) = &PL_sv_placeholder; |
1104
|
16009079
|
50
|
|
|
|
if (sv) { |
1105
|
|
|
|
|
|
/* deletion of method from stash */ |
1106
|
16009079
|
100
|
|
|
|
if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1107
|
61662
|
50
|
|
|
|
&& HvENAME_get(hv)) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1108
|
61658
|
|
|
|
|
mro_method_changed_in(hv); |
1109
|
|
|
|
|
|
} |
1110
|
|
|
|
|
|
|
1111
|
|
|
|
|
|
/* |
1112
|
|
|
|
|
|
* If a restricted hash, rather than really deleting the entry, put |
1113
|
|
|
|
|
|
* a placeholder there. This marks the key as being "approved", so |
1114
|
|
|
|
|
|
* we can still access via not-really-existing key without raising |
1115
|
|
|
|
|
|
* an error. |
1116
|
|
|
|
|
|
*/ |
1117
|
16009079
|
100
|
|
|
|
if (SvREADONLY(hv)) |
1118
|
|
|
|
|
|
/* We'll be saving this slot, so the number of allocated keys |
1119
|
|
|
|
|
|
* doesn't go down, but the number placeholders goes up */ |
1120
|
10264
|
|
|
|
|
HvPLACEHOLDERS(hv)++; |
1121
|
|
|
|
|
|
else { |
1122
|
15998815
|
|
|
|
|
*oentry = HeNEXT(entry); |
1123
|
15998815
|
100
|
|
|
|
if(!*first_entry && SvOOK(hv)) { |
|
|
100
|
|
|
|
|
1124
|
|
|
|
|
|
/* removed last entry, and aux struct present. */ |
1125
|
3481457
|
|
|
|
|
struct xpvhv_aux *const aux = HvAUX(hv); |
1126
|
3481457
|
100
|
|
|
|
if (aux->xhv_fill_lazy) |
1127
|
1188
|
|
|
|
|
--aux->xhv_fill_lazy; |
1128
|
|
|
|
|
|
} |
1129
|
15998815
|
100
|
|
|
|
if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */) |
|
|
100
|
|
|
|
|
1130
|
10
|
|
|
|
|
HvLAZYDEL_on(hv); |
1131
|
|
|
|
|
|
else { |
1132
|
15998806
|
100
|
|
|
|
if (SvOOK(hv) && HvLAZYDEL(hv) && |
|
|
50
|
|
|
|
|
1133
|
2
|
|
|
|
|
entry == HeNEXT(HvAUX(hv)->xhv_eiter)) |
1134
|
2
|
|
|
|
|
HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry); |
1135
|
15998805
|
|
|
|
|
hv_free_ent(hv, entry); |
1136
|
|
|
|
|
|
} |
1137
|
15998815
|
|
|
|
|
xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */ |
1138
|
15998815
|
100
|
|
|
|
if (xhv->xhv_keys == 0) |
1139
|
1695590
|
|
|
|
|
HvHASKFLAGS_off(hv); |
1140
|
|
|
|
|
|
} |
1141
|
|
|
|
|
|
|
1142
|
16009079
|
100
|
|
|
|
if (d_flags & G_DISCARD) { |
1143
|
13093709
|
|
|
|
|
SvREFCNT_dec(sv); |
1144
|
|
|
|
|
|
sv = NULL; |
1145
|
|
|
|
|
|
} |
1146
|
|
|
|
|
|
|
1147
|
16009079
|
100
|
|
|
|
if (mro_changes == 1) mro_isa_changed_in(hv); |
1148
|
16009075
|
100
|
|
|
|
else if (mro_changes == 2) |
1149
|
146
|
|
|
|
|
mro_package_moved(NULL, stash, gv, 1); |
1150
|
|
|
|
|
|
|
1151
|
|
|
|
|
|
return sv; |
1152
|
|
|
|
|
|
} |
1153
|
4718118
|
50
|
|
|
|
if (SvREADONLY(hv)) { |
1154
|
0
|
|
|
|
|
hv_notallowed(k_flags, key, klen, |
1155
|
|
|
|
|
|
"Attempt to delete disallowed key '%"SVf"' from" |
1156
|
|
|
|
|
|
" a restricted hash"); |
1157
|
|
|
|
|
|
} |
1158
|
|
|
|
|
|
|
1159
|
4718118
|
50
|
|
|
|
if (k_flags & HVhek_FREEKEY) |
1160
|
10432079
|
|
|
|
|
Safefree(key); |
1161
|
|
|
|
|
|
return NULL; |
1162
|
|
|
|
|
|
} |
1163
|
|
|
|
|
|
|
1164
|
|
|
|
|
|
STATIC void |
1165
|
9248142
|
|
|
|
|
S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) |
1166
|
|
|
|
|
|
{ |
1167
|
|
|
|
|
|
dVAR; |
1168
|
|
|
|
|
|
STRLEN i = 0; |
1169
|
9248142
|
|
|
|
|
char *a = (char*) HvARRAY(hv); |
1170
|
|
|
|
|
|
HE **aep; |
1171
|
|
|
|
|
|
|
1172
|
|
|
|
|
|
PERL_ARGS_ASSERT_HSPLIT; |
1173
|
|
|
|
|
|
|
1174
|
|
|
|
|
|
/*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n", |
1175
|
|
|
|
|
|
(void*)hv, (int) oldsize);*/ |
1176
|
|
|
|
|
|
|
1177
|
9248142
|
|
|
|
|
PL_nomemok = TRUE; |
1178
|
9248142
|
100
|
|
|
|
Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize) |
1179
|
|
|
|
|
|
+ (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char); |
1180
|
9248142
|
50
|
|
|
|
if (!a) { |
1181
|
0
|
|
|
|
|
PL_nomemok = FALSE; |
1182
|
0
|
|
|
|
|
return; |
1183
|
|
|
|
|
|
} |
1184
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
1185
|
|
|
|
|
|
/* the idea of this is that we create a "random" value by hashing the address of |
1186
|
|
|
|
|
|
* the array, we then use the low bit to decide if we insert at the top, or insert |
1187
|
|
|
|
|
|
* second from top. After each such insert we rotate the hashed value. So we can |
1188
|
|
|
|
|
|
* use the same hashed value over and over, and in normal build environments use |
1189
|
|
|
|
|
|
* very few ops to do so. ROTL32() should produce a single machine operation. */ |
1190
|
9248142
|
100
|
|
|
|
if (PL_HASH_RAND_BITS_ENABLED) { |
1191
|
9248098
|
100
|
|
|
|
if (PL_HASH_RAND_BITS_ENABLED == 1) |
1192
|
13829002
|
|
|
|
|
PL_hash_rand_bits += ptr_hash((PTRV)a); |
1193
|
9248098
|
|
|
|
|
PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,1); |
1194
|
|
|
|
|
|
} |
1195
|
|
|
|
|
|
#endif |
1196
|
|
|
|
|
|
|
1197
|
9248142
|
100
|
|
|
|
if (SvOOK(hv)) { |
1198
|
1378273
|
|
|
|
|
struct xpvhv_aux *const dest |
1199
|
1378273
|
|
|
|
|
= (struct xpvhv_aux*) &a[newsize * sizeof(HE*)]; |
1200
|
1378273
|
|
|
|
|
Move(&a[oldsize * sizeof(HE*)], dest, 1, struct xpvhv_aux); |
1201
|
|
|
|
|
|
/* we reset the iterator's xhv_rand as well, so they get a totally new ordering */ |
1202
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
1203
|
1378273
|
|
|
|
|
dest->xhv_rand = (U32)PL_hash_rand_bits; |
1204
|
|
|
|
|
|
#endif |
1205
|
|
|
|
|
|
/* For now, just reset the lazy fill counter. |
1206
|
|
|
|
|
|
It would be possible to update the counter in the code below |
1207
|
|
|
|
|
|
instead. */ |
1208
|
1378273
|
|
|
|
|
dest->xhv_fill_lazy = 0; |
1209
|
|
|
|
|
|
} |
1210
|
|
|
|
|
|
|
1211
|
9248142
|
|
|
|
|
PL_nomemok = FALSE; |
1212
|
9248142
|
|
|
|
|
Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/ |
1213
|
9248142
|
|
|
|
|
HvMAX(hv) = --newsize; |
1214
|
9248142
|
|
|
|
|
HvARRAY(hv) = (HE**) a; |
1215
|
|
|
|
|
|
|
1216
|
9248142
|
50
|
|
|
|
if (!HvTOTALKEYS(hv)) /* skip rest if no entries */ |
1217
|
|
|
|
|
|
return; |
1218
|
|
|
|
|
|
|
1219
|
|
|
|
|
|
aep = (HE**)a; |
1220
|
|
|
|
|
|
do { |
1221
|
272205918
|
|
|
|
|
HE **oentry = aep + i; |
1222
|
272205918
|
|
|
|
|
HE *entry = aep[i]; |
1223
|
|
|
|
|
|
|
1224
|
272205918
|
100
|
|
|
|
if (!entry) /* non-existent */ |
1225
|
187297003
|
|
|
|
|
continue; |
1226
|
|
|
|
|
|
do { |
1227
|
267638057
|
|
|
|
|
U32 j = (HeHASH(entry) & newsize); |
1228
|
267638057
|
100
|
|
|
|
if (j != (U32)i) { |
1229
|
131706227
|
|
|
|
|
*oentry = HeNEXT(entry); |
1230
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
1231
|
|
|
|
|
|
/* if the target cell is empty or PL_HASH_RAND_BITS_ENABLED is false |
1232
|
|
|
|
|
|
* insert to top, otherwise rotate the bucket rand 1 bit, |
1233
|
|
|
|
|
|
* and use the new low bit to decide if we insert at top, |
1234
|
|
|
|
|
|
* or next from top. IOW, we only rotate on a collision.*/ |
1235
|
131706227
|
100
|
|
|
|
if (aep[j] && PL_HASH_RAND_BITS_ENABLED) { |
|
|
100
|
|
|
|
|
1236
|
27293725
|
|
|
|
|
PL_hash_rand_bits+= ROTL_UV(HeHASH(entry), 17); |
1237
|
27293725
|
|
|
|
|
PL_hash_rand_bits= ROTL_UV(PL_hash_rand_bits,1); |
1238
|
27293725
|
100
|
|
|
|
if (PL_hash_rand_bits & 1) { |
1239
|
13639114
|
|
|
|
|
HeNEXT(entry)= HeNEXT(aep[j]); |
1240
|
13639114
|
|
|
|
|
HeNEXT(aep[j])= entry; |
1241
|
|
|
|
|
|
} else { |
1242
|
|
|
|
|
|
/* Note, this is structured in such a way as the optimizer |
1243
|
|
|
|
|
|
* should eliminate the duplicated code here and below without |
1244
|
|
|
|
|
|
* us needing to explicitly use a goto. */ |
1245
|
13654611
|
|
|
|
|
HeNEXT(entry) = aep[j]; |
1246
|
13654611
|
|
|
|
|
aep[j] = entry; |
1247
|
|
|
|
|
|
} |
1248
|
|
|
|
|
|
} else |
1249
|
|
|
|
|
|
#endif |
1250
|
|
|
|
|
|
{ |
1251
|
|
|
|
|
|
/* see comment above about duplicated code */ |
1252
|
104412502
|
|
|
|
|
HeNEXT(entry) = aep[j]; |
1253
|
104412502
|
|
|
|
|
aep[j] = entry; |
1254
|
|
|
|
|
|
} |
1255
|
|
|
|
|
|
} |
1256
|
|
|
|
|
|
else { |
1257
|
135931830
|
|
|
|
|
oentry = &HeNEXT(entry); |
1258
|
|
|
|
|
|
} |
1259
|
267638057
|
|
|
|
|
entry = *oentry; |
1260
|
267638057
|
100
|
|
|
|
} while (entry); |
1261
|
272205918
|
100
|
|
|
|
} while (i++ < oldsize); |
1262
|
|
|
|
|
|
} |
1263
|
|
|
|
|
|
|
1264
|
|
|
|
|
|
void |
1265
|
89155932
|
|
|
|
|
Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) |
1266
|
|
|
|
|
|
{ |
1267
|
|
|
|
|
|
dVAR; |
1268
|
89155932
|
|
|
|
|
XPVHV* xhv = (XPVHV*)SvANY(hv); |
1269
|
89155932
|
|
|
|
|
const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */ |
1270
|
|
|
|
|
|
I32 newsize; |
1271
|
|
|
|
|
|
char *a; |
1272
|
|
|
|
|
|
|
1273
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_KSPLIT; |
1274
|
|
|
|
|
|
|
1275
|
89155932
|
|
|
|
|
newsize = (I32) newmax; /* possible truncation here */ |
1276
|
89155932
|
50
|
|
|
|
if (newsize != newmax || newmax <= oldsize) |
|
|
100
|
|
|
|
|
1277
|
|
|
|
|
|
return; |
1278
|
2690592
|
100
|
|
|
|
while ((newsize & (1 + ~newsize)) != newsize) { |
1279
|
1695050
|
|
|
|
|
newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */ |
1280
|
|
|
|
|
|
} |
1281
|
995542
|
100
|
|
|
|
if (newsize < newmax) |
1282
|
923550
|
|
|
|
|
newsize *= 2; |
1283
|
995542
|
50
|
|
|
|
if (newsize < newmax) |
1284
|
|
|
|
|
|
return; /* overflow detection */ |
1285
|
|
|
|
|
|
|
1286
|
995542
|
|
|
|
|
a = (char *) HvARRAY(hv); |
1287
|
995542
|
100
|
|
|
|
if (a) { |
1288
|
8
|
|
|
|
|
hsplit(hv, oldsize, newsize); |
1289
|
|
|
|
|
|
} else { |
1290
|
995534
|
|
|
|
|
Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char); |
1291
|
995534
|
|
|
|
|
xhv->xhv_max = --newsize; |
1292
|
45075733
|
|
|
|
|
HvARRAY(hv) = (HE **) a; |
1293
|
|
|
|
|
|
} |
1294
|
|
|
|
|
|
} |
1295
|
|
|
|
|
|
|
1296
|
|
|
|
|
|
/* IMO this should also handle cases where hv_max is smaller than hv_keys |
1297
|
|
|
|
|
|
* as tied hashes could play silly buggers and mess us around. We will |
1298
|
|
|
|
|
|
* do the right thing during hv_store() afterwards, but still - Yves */ |
1299
|
|
|
|
|
|
#define HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys) STMT_START {\ |
1300
|
|
|
|
|
|
/* Can we use fewer buckets? (hv_max is always 2^n-1) */ \ |
1301
|
|
|
|
|
|
if (hv_max < PERL_HASH_DEFAULT_HvMAX) { \ |
1302
|
|
|
|
|
|
hv_max = PERL_HASH_DEFAULT_HvMAX; \ |
1303
|
|
|
|
|
|
} else { \ |
1304
|
|
|
|
|
|
while (hv_max > PERL_HASH_DEFAULT_HvMAX && hv_max + 1 >= hv_keys * 2) \ |
1305
|
|
|
|
|
|
hv_max = hv_max / 2; \ |
1306
|
|
|
|
|
|
} \ |
1307
|
|
|
|
|
|
HvMAX(hv) = hv_max; \ |
1308
|
|
|
|
|
|
} STMT_END |
1309
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
1311
|
|
|
|
|
|
HV * |
1312
|
497252
|
|
|
|
|
Perl_newHVhv(pTHX_ HV *ohv) |
1313
|
|
|
|
|
|
{ |
1314
|
|
|
|
|
|
dVAR; |
1315
|
497252
|
|
|
|
|
HV * const hv = newHV(); |
1316
|
|
|
|
|
|
STRLEN hv_max; |
1317
|
|
|
|
|
|
|
1318
|
497252
|
50
|
|
|
|
if (!ohv || (!HvTOTALKEYS(ohv) && !SvMAGICAL((const SV *)ohv))) |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
1319
|
|
|
|
|
|
return hv; |
1320
|
497252
|
|
|
|
|
hv_max = HvMAX(ohv); |
1321
|
|
|
|
|
|
|
1322
|
497252
|
100
|
|
|
|
if (!SvMAGICAL((const SV *)ohv)) { |
1323
|
|
|
|
|
|
/* It's an ordinary hash, so copy it fast. AMS 20010804 */ |
1324
|
|
|
|
|
|
STRLEN i; |
1325
|
497250
|
|
|
|
|
const bool shared = !!HvSHAREKEYS(ohv); |
1326
|
497250
|
|
|
|
|
HE **ents, ** const oents = (HE **)HvARRAY(ohv); |
1327
|
|
|
|
|
|
char *a; |
1328
|
497250
|
|
|
|
|
Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char); |
1329
|
|
|
|
|
|
ents = (HE**)a; |
1330
|
|
|
|
|
|
|
1331
|
|
|
|
|
|
/* In each bucket... */ |
1332
|
4975618
|
100
|
|
|
|
for (i = 0; i <= hv_max; i++) { |
1333
|
|
|
|
|
|
HE *prev = NULL; |
1334
|
4478368
|
|
|
|
|
HE *oent = oents[i]; |
1335
|
|
|
|
|
|
|
1336
|
4478368
|
100
|
|
|
|
if (!oent) { |
1337
|
3022782
|
|
|
|
|
ents[i] = NULL; |
1338
|
3022782
|
|
|
|
|
continue; |
1339
|
|
|
|
|
|
} |
1340
|
|
|
|
|
|
|
1341
|
|
|
|
|
|
/* Copy the linked list of entries. */ |
1342
|
2487315
|
100
|
|
|
|
for (; oent; oent = HeNEXT(oent)) { |
1343
|
1720644
|
|
|
|
|
const U32 hash = HeHASH(oent); |
1344
|
1720644
|
|
|
|
|
const char * const key = HeKEY(oent); |
1345
|
1720644
|
|
|
|
|
const STRLEN len = HeKLEN(oent); |
1346
|
1720644
|
|
|
|
|
const int flags = HeKFLAGS(oent); |
1347
|
1720644
|
|
|
|
|
HE * const ent = new_HE(); |
1348
|
1720644
|
|
|
|
|
SV *const val = HeVAL(oent); |
1349
|
|
|
|
|
|
|
1350
|
1720644
|
50
|
|
|
|
HeVAL(ent) = SvIMMORTAL(val) ? val : newSVsv(val); |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1351
|
|
|
|
|
|
HeKEY_hek(ent) |
1352
|
3441288
|
|
|
|
|
= shared ? share_hek_flags(key, len, hash, flags) |
1353
|
2534708
|
50
|
|
|
|
: save_hek_flags(key, len, hash, flags); |
1354
|
1720644
|
100
|
|
|
|
if (prev) |
1355
|
265058
|
|
|
|
|
HeNEXT(prev) = ent; |
1356
|
|
|
|
|
|
else |
1357
|
1455586
|
|
|
|
|
ents[i] = ent; |
1358
|
|
|
|
|
|
prev = ent; |
1359
|
1720644
|
|
|
|
|
HeNEXT(ent) = NULL; |
1360
|
|
|
|
|
|
} |
1361
|
|
|
|
|
|
} |
1362
|
|
|
|
|
|
|
1363
|
497250
|
|
|
|
|
HvMAX(hv) = hv_max; |
1364
|
497250
|
|
|
|
|
HvTOTALKEYS(hv) = HvTOTALKEYS(ohv); |
1365
|
497250
|
|
|
|
|
HvARRAY(hv) = ents; |
1366
|
|
|
|
|
|
} /* not magical */ |
1367
|
|
|
|
|
|
else { |
1368
|
|
|
|
|
|
/* Iterate over ohv, copying keys and values one at a time. */ |
1369
|
|
|
|
|
|
HE *entry; |
1370
|
2
|
50
|
|
|
|
const I32 riter = HvRITER_get(ohv); |
1371
|
2
|
50
|
|
|
|
HE * const eiter = HvEITER_get(ohv); |
1372
|
2
|
|
|
|
|
STRLEN hv_keys = HvTOTALKEYS(ohv); |
1373
|
|
|
|
|
|
|
1374
|
2
|
50
|
|
|
|
HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys); |
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
1375
|
|
|
|
|
|
|
1376
|
2
|
|
|
|
|
hv_iterinit(ohv); |
1377
|
5
|
100
|
|
|
|
while ((entry = hv_iternext_flags(ohv, 0))) { |
1378
|
2
|
|
|
|
|
SV *val = hv_iterval(ohv,entry); |
1379
|
2
|
50
|
|
|
|
SV * const keysv = HeSVKEY(entry); |
|
|
50
|
|
|
|
|
1380
|
2
|
50
|
|
|
|
val = SvIMMORTAL(val) ? val : newSVsv(val); |
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
0
|
|
|
|
|
1381
|
2
|
50
|
|
|
|
if (keysv) |
1382
|
0
|
|
|
|
|
(void)hv_store_ent(hv, keysv, val, 0); |
1383
|
|
|
|
|
|
else |
1384
|
2
|
|
|
|
|
(void)hv_store_flags(hv, HeKEY(entry), HeKLEN(entry), val, |
1385
|
|
|
|
|
|
HeHASH(entry), HeKFLAGS(entry)); |
1386
|
|
|
|
|
|
} |
1387
|
2
|
|
|
|
|
HvRITER_set(ohv, riter); |
1388
|
260866
|
|
|
|
|
HvEITER_set(ohv, eiter); |
1389
|
|
|
|
|
|
} |
1390
|
|
|
|
|
|
|
1391
|
|
|
|
|
|
return hv; |
1392
|
|
|
|
|
|
} |
1393
|
|
|
|
|
|
|
1394
|
|
|
|
|
|
/* |
1395
|
|
|
|
|
|
=for apidoc Am|HV *|hv_copy_hints_hv|HV *ohv |
1396
|
|
|
|
|
|
|
1397
|
|
|
|
|
|
A specialised version of L for copying C<%^H>. I must be |
1398
|
|
|
|
|
|
a pointer to a hash (which may have C<%^H> magic, but should be generally |
1399
|
|
|
|
|
|
non-magical), or C (interpreted as an empty hash). The content |
1400
|
|
|
|
|
|
of I is copied to a new hash, which has the C<%^H>-specific magic |
1401
|
|
|
|
|
|
added to it. A pointer to the new hash is returned. |
1402
|
|
|
|
|
|
|
1403
|
|
|
|
|
|
=cut |
1404
|
|
|
|
|
|
*/ |
1405
|
|
|
|
|
|
|
1406
|
|
|
|
|
|
HV * |
1407
|
1076168
|
|
|
|
|
Perl_hv_copy_hints_hv(pTHX_ HV *const ohv) |
1408
|
|
|
|
|
|
{ |
1409
|
1076168
|
|
|
|
|
HV * const hv = newHV(); |
1410
|
|
|
|
|
|
|
1411
|
1076168
|
50
|
|
|
|
if (ohv) { |
1412
|
1076168
|
|
|
|
|
STRLEN hv_max = HvMAX(ohv); |
1413
|
1076168
|
|
|
|
|
STRLEN hv_keys = HvTOTALKEYS(ohv); |
1414
|
|
|
|
|
|
HE *entry; |
1415
|
1076168
|
100
|
|
|
|
const I32 riter = HvRITER_get(ohv); |
1416
|
1076168
|
100
|
|
|
|
HE * const eiter = HvEITER_get(ohv); |
1417
|
|
|
|
|
|
|
1418
|
1076168
|
|
|
|
|
ENTER; |
1419
|
1076168
|
|
|
|
|
SAVEFREESV(hv); |
1420
|
|
|
|
|
|
|
1421
|
1076217
|
50
|
|
|
|
HV_SET_MAX_ADJUSTED_FOR_KEYS(hv,hv_max,hv_keys); |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1422
|
|
|
|
|
|
|
1423
|
1076168
|
|
|
|
|
hv_iterinit(ohv); |
1424
|
8253428
|
100
|
|
|
|
while ((entry = hv_iternext_flags(ohv, 0))) { |
1425
|
6639360
|
|
|
|
|
SV *const sv = newSVsv(hv_iterval(ohv,entry)); |
1426
|
6639356
|
50
|
|
|
|
SV *heksv = HeSVKEY(entry); |
|
|
100
|
|
|
|
|
1427
|
6639356
|
100
|
|
|
|
if (!heksv && sv) heksv = newSVhek(HeKEY_hek(entry)); |
1428
|
6639356
|
50
|
|
|
|
if (sv) sv_magic(sv, NULL, PERL_MAGIC_hintselem, |
1429
|
|
|
|
|
|
(char *)heksv, HEf_SVKEY); |
1430
|
6639356
|
50
|
|
|
|
if (heksv == HeSVKEY(entry)) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1431
|
6
|
|
|
|
|
(void)hv_store_ent(hv, heksv, sv, 0); |
1432
|
|
|
|
|
|
else { |
1433
|
6639350
|
|
|
|
|
(void)hv_common(hv, heksv, HeKEY(entry), HeKLEN(entry), |
1434
|
|
|
|
|
|
HeKFLAGS(entry), HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, sv, HeHASH(entry)); |
1435
|
6639353
|
|
|
|
|
SvREFCNT_dec_NN(heksv); |
1436
|
|
|
|
|
|
} |
1437
|
|
|
|
|
|
} |
1438
|
1076162
|
|
|
|
|
HvRITER_set(ohv, riter); |
1439
|
1076162
|
|
|
|
|
HvEITER_set(ohv, eiter); |
1440
|
|
|
|
|
|
|
1441
|
1076162
|
|
|
|
|
SvREFCNT_inc_simple_void_NN(hv); |
1442
|
1076162
|
|
|
|
|
LEAVE; |
1443
|
|
|
|
|
|
} |
1444
|
1076162
|
|
|
|
|
hv_magic(hv, NULL, PERL_MAGIC_hints); |
1445
|
1076162
|
|
|
|
|
return hv; |
1446
|
|
|
|
|
|
} |
1447
|
|
|
|
|
|
#undef HV_SET_MAX_ADJUSTED_FOR_KEYS |
1448
|
|
|
|
|
|
|
1449
|
|
|
|
|
|
/* like hv_free_ent, but returns the SV rather than freeing it */ |
1450
|
|
|
|
|
|
STATIC SV* |
1451
|
446804367
|
|
|
|
|
S_hv_free_ent_ret(pTHX_ HV *hv, HE *entry) |
1452
|
|
|
|
|
|
{ |
1453
|
|
|
|
|
|
dVAR; |
1454
|
|
|
|
|
|
SV *val; |
1455
|
|
|
|
|
|
|
1456
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_FREE_ENT_RET; |
1457
|
|
|
|
|
|
|
1458
|
446804367
|
|
|
|
|
val = HeVAL(entry); |
1459
|
446804367
|
100
|
|
|
|
if (HeKLEN(entry) == HEf_SVKEY) { |
1460
|
24
|
|
|
|
|
SvREFCNT_dec(HeKEY_sv(entry)); |
1461
|
24
|
|
|
|
|
Safefree(HeKEY_hek(entry)); |
1462
|
|
|
|
|
|
} |
1463
|
446804343
|
50
|
|
|
|
else if (HvSHAREKEYS(hv)) |
1464
|
446804343
|
|
|
|
|
unshare_hek(HeKEY_hek(entry)); |
1465
|
|
|
|
|
|
else |
1466
|
0
|
|
|
|
|
Safefree(HeKEY_hek(entry)); |
1467
|
446804367
|
|
|
|
|
del_HE(entry); |
1468
|
446804367
|
|
|
|
|
return val; |
1469
|
|
|
|
|
|
} |
1470
|
|
|
|
|
|
|
1471
|
|
|
|
|
|
|
1472
|
|
|
|
|
|
void |
1473
|
17381789
|
|
|
|
|
Perl_hv_free_ent(pTHX_ HV *hv, HE *entry) |
1474
|
|
|
|
|
|
{ |
1475
|
|
|
|
|
|
dVAR; |
1476
|
|
|
|
|
|
SV *val; |
1477
|
|
|
|
|
|
|
1478
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_FREE_ENT; |
1479
|
|
|
|
|
|
|
1480
|
17381789
|
50
|
|
|
|
if (!entry) |
1481
|
17381789
|
|
|
|
|
return; |
1482
|
17381789
|
|
|
|
|
val = hv_free_ent_ret(hv, entry); |
1483
|
17381789
|
|
|
|
|
SvREFCNT_dec(val); |
1484
|
|
|
|
|
|
} |
1485
|
|
|
|
|
|
|
1486
|
|
|
|
|
|
|
1487
|
|
|
|
|
|
void |
1488
|
0
|
|
|
|
|
Perl_hv_delayfree_ent(pTHX_ HV *hv, HE *entry) |
1489
|
|
|
|
|
|
{ |
1490
|
|
|
|
|
|
dVAR; |
1491
|
|
|
|
|
|
|
1492
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_DELAYFREE_ENT; |
1493
|
|
|
|
|
|
|
1494
|
0
|
0
|
|
|
|
if (!entry) |
1495
|
0
|
|
|
|
|
return; |
1496
|
|
|
|
|
|
/* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent */ |
1497
|
0
|
|
|
|
|
sv_2mortal(SvREFCNT_inc(HeVAL(entry))); /* free between statements */ |
1498
|
0
|
0
|
|
|
|
if (HeKLEN(entry) == HEf_SVKEY) { |
1499
|
0
|
|
|
|
|
sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry))); |
1500
|
|
|
|
|
|
} |
1501
|
0
|
|
|
|
|
hv_free_ent(hv, entry); |
1502
|
|
|
|
|
|
} |
1503
|
|
|
|
|
|
|
1504
|
|
|
|
|
|
/* |
1505
|
|
|
|
|
|
=for apidoc hv_clear |
1506
|
|
|
|
|
|
|
1507
|
|
|
|
|
|
Frees the all the elements of a hash, leaving it empty. |
1508
|
|
|
|
|
|
The XS equivalent of C<%hash = ()>. See also L. |
1509
|
|
|
|
|
|
|
1510
|
|
|
|
|
|
If any destructors are triggered as a result, the hv itself may |
1511
|
|
|
|
|
|
be freed. |
1512
|
|
|
|
|
|
|
1513
|
|
|
|
|
|
=cut |
1514
|
|
|
|
|
|
*/ |
1515
|
|
|
|
|
|
|
1516
|
|
|
|
|
|
void |
1517
|
16881540
|
|
|
|
|
Perl_hv_clear(pTHX_ HV *hv) |
1518
|
|
|
|
|
|
{ |
1519
|
|
|
|
|
|
dVAR; |
1520
|
|
|
|
|
|
XPVHV* xhv; |
1521
|
16881540
|
50
|
|
|
|
if (!hv) |
1522
|
16881536
|
|
|
|
|
return; |
1523
|
|
|
|
|
|
|
1524
|
|
|
|
|
|
DEBUG_A(Perl_hv_assert(aTHX_ hv)); |
1525
|
|
|
|
|
|
|
1526
|
16881540
|
|
|
|
|
xhv = (XPVHV*)SvANY(hv); |
1527
|
|
|
|
|
|
|
1528
|
16881540
|
|
|
|
|
ENTER; |
1529
|
16881540
|
|
|
|
|
SAVEFREESV(SvREFCNT_inc_simple_NN(hv)); |
1530
|
16881540
|
100
|
|
|
|
if (SvREADONLY(hv) && HvARRAY(hv) != NULL) { |
|
|
50
|
|
|
|
|
1531
|
|
|
|
|
|
/* restricted hash: convert all keys to placeholders */ |
1532
|
|
|
|
|
|
STRLEN i; |
1533
|
34
|
100
|
|
|
|
for (i = 0; i <= xhv->xhv_max; i++) { |
1534
|
32
|
|
|
|
|
HE *entry = (HvARRAY(hv))[i]; |
1535
|
44
|
100
|
|
|
|
for (; entry; entry = HeNEXT(entry)) { |
1536
|
|
|
|
|
|
/* not already placeholder */ |
1537
|
12
|
100
|
|
|
|
if (HeVAL(entry) != &PL_sv_placeholder) { |
1538
|
4
|
50
|
|
|
|
if (HeVAL(entry)) { |
1539
|
4
|
50
|
|
|
|
if (SvREADONLY(HeVAL(entry))) { |
1540
|
0
|
|
|
|
|
SV* const keysv = hv_iterkeysv(entry); |
1541
|
0
|
|
|
|
|
Perl_croak_nocontext( |
1542
|
|
|
|
|
|
"Attempt to delete readonly key '%"SVf"' from a restricted hash", |
1543
|
|
|
|
|
|
(void*)keysv); |
1544
|
|
|
|
|
|
} |
1545
|
4
|
|
|
|
|
SvREFCNT_dec_NN(HeVAL(entry)); |
1546
|
|
|
|
|
|
} |
1547
|
4
|
|
|
|
|
HeVAL(entry) = &PL_sv_placeholder; |
1548
|
4
|
|
|
|
|
HvPLACEHOLDERS(hv)++; |
1549
|
|
|
|
|
|
} |
1550
|
|
|
|
|
|
} |
1551
|
|
|
|
|
|
} |
1552
|
|
|
|
|
|
} |
1553
|
|
|
|
|
|
else { |
1554
|
16881536
|
|
|
|
|
hfreeentries(hv); |
1555
|
16881536
|
|
|
|
|
HvPLACEHOLDERS_set(hv, 0); |
1556
|
|
|
|
|
|
|
1557
|
16881536
|
100
|
|
|
|
if (SvRMAGICAL(hv)) |
1558
|
595783
|
|
|
|
|
mg_clear(MUTABLE_SV(hv)); |
1559
|
|
|
|
|
|
|
1560
|
16881532
|
|
|
|
|
HvHASKFLAGS_off(hv); |
1561
|
|
|
|
|
|
} |
1562
|
16881536
|
100
|
|
|
|
if (SvOOK(hv)) { |
1563
|
700514
|
50
|
|
|
|
if(HvENAME_get(hv)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1564
|
62
|
|
|
|
|
mro_isa_changed_in(hv); |
1565
|
700514
|
|
|
|
|
HvEITER_set(hv, NULL); |
1566
|
|
|
|
|
|
} |
1567
|
16881536
|
|
|
|
|
LEAVE; |
1568
|
|
|
|
|
|
} |
1569
|
|
|
|
|
|
|
1570
|
|
|
|
|
|
/* |
1571
|
|
|
|
|
|
=for apidoc hv_clear_placeholders |
1572
|
|
|
|
|
|
|
1573
|
|
|
|
|
|
Clears any placeholders from a hash. If a restricted hash has any of its keys |
1574
|
|
|
|
|
|
marked as readonly and the key is subsequently deleted, the key is not actually |
1575
|
|
|
|
|
|
deleted but is marked by assigning it a value of &PL_sv_placeholder. This tags |
1576
|
|
|
|
|
|
it so it will be ignored by future operations such as iterating over the hash, |
1577
|
|
|
|
|
|
but will still allow the hash to have a value reassigned to the key at some |
1578
|
|
|
|
|
|
future point. This function clears any such placeholder keys from the hash. |
1579
|
|
|
|
|
|
See Hash::Util::lock_keys() for an example of its use. |
1580
|
|
|
|
|
|
|
1581
|
|
|
|
|
|
=cut |
1582
|
|
|
|
|
|
*/ |
1583
|
|
|
|
|
|
|
1584
|
|
|
|
|
|
void |
1585
|
230
|
|
|
|
|
Perl_hv_clear_placeholders(pTHX_ HV *hv) |
1586
|
|
|
|
|
|
{ |
1587
|
|
|
|
|
|
dVAR; |
1588
|
230
|
50
|
|
|
|
const U32 items = (U32)HvPLACEHOLDERS_get(hv); |
1589
|
|
|
|
|
|
|
1590
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS; |
1591
|
|
|
|
|
|
|
1592
|
230
|
50
|
|
|
|
if (items) |
1593
|
0
|
|
|
|
|
clear_placeholders(hv, items); |
1594
|
230
|
|
|
|
|
} |
1595
|
|
|
|
|
|
|
1596
|
|
|
|
|
|
static void |
1597
|
173942
|
|
|
|
|
S_clear_placeholders(pTHX_ HV *hv, U32 items) |
1598
|
|
|
|
|
|
{ |
1599
|
|
|
|
|
|
dVAR; |
1600
|
|
|
|
|
|
I32 i; |
1601
|
|
|
|
|
|
|
1602
|
|
|
|
|
|
PERL_ARGS_ASSERT_CLEAR_PLACEHOLDERS; |
1603
|
|
|
|
|
|
|
1604
|
173942
|
50
|
|
|
|
if (items == 0) |
1605
|
|
|
|
|
|
return; |
1606
|
|
|
|
|
|
|
1607
|
173942
|
|
|
|
|
i = HvMAX(hv); |
1608
|
|
|
|
|
|
do { |
1609
|
|
|
|
|
|
/* Loop down the linked list heads */ |
1610
|
1377790
|
|
|
|
|
HE **oentry = &(HvARRAY(hv))[i]; |
1611
|
|
|
|
|
|
HE *entry; |
1612
|
|
|
|
|
|
|
1613
|
3625635
|
100
|
|
|
|
while ((entry = *oentry)) { |
1614
|
1732892
|
100
|
|
|
|
if (HeVAL(entry) == &PL_sv_placeholder) { |
1615
|
1382950
|
|
|
|
|
*oentry = HeNEXT(entry); |
1616
|
1382950
|
50
|
|
|
|
if (entry == HvEITER_get(hv)) |
|
|
50
|
|
|
|
|
1617
|
0
|
|
|
|
|
HvLAZYDEL_on(hv); |
1618
|
|
|
|
|
|
else { |
1619
|
1382950
|
50
|
|
|
|
if (SvOOK(hv) && HvLAZYDEL(hv) && |
|
|
0
|
|
|
|
|
1620
|
0
|
|
|
|
|
entry == HeNEXT(HvAUX(hv)->xhv_eiter)) |
1621
|
0
|
|
|
|
|
HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry); |
1622
|
1382950
|
|
|
|
|
hv_free_ent(hv, entry); |
1623
|
|
|
|
|
|
} |
1624
|
|
|
|
|
|
|
1625
|
1382950
|
100
|
|
|
|
if (--items == 0) { |
1626
|
|
|
|
|
|
/* Finished. */ |
1627
|
173942
|
50
|
|
|
|
HvTOTALKEYS(hv) -= (IV)HvPLACEHOLDERS_get(hv); |
1628
|
173942
|
50
|
|
|
|
if (HvUSEDKEYS(hv) == 0) |
|
|
50
|
|
|
|
|
1629
|
0
|
|
|
|
|
HvHASKFLAGS_off(hv); |
1630
|
173942
|
|
|
|
|
HvPLACEHOLDERS_set(hv, 0); |
1631
|
173942
|
|
|
|
|
return; |
1632
|
|
|
|
|
|
} |
1633
|
|
|
|
|
|
} else { |
1634
|
954446
|
|
|
|
|
oentry = &HeNEXT(entry); |
1635
|
|
|
|
|
|
} |
1636
|
|
|
|
|
|
} |
1637
|
1203848
|
50
|
|
|
|
} while (--i >= 0); |
1638
|
|
|
|
|
|
/* You can't get here, hence assertion should always fail. */ |
1639
|
|
|
|
|
|
assert (items == 0); |
1640
|
|
|
|
|
|
assert (0); |
1641
|
|
|
|
|
|
} |
1642
|
|
|
|
|
|
|
1643
|
|
|
|
|
|
STATIC void |
1644
|
128932480
|
|
|
|
|
S_hfreeentries(pTHX_ HV *hv) |
1645
|
|
|
|
|
|
{ |
1646
|
128932480
|
|
|
|
|
STRLEN index = 0; |
1647
|
128932480
|
|
|
|
|
XPVHV * const xhv = (XPVHV*)SvANY(hv); |
1648
|
|
|
|
|
|
SV *sv; |
1649
|
|
|
|
|
|
|
1650
|
|
|
|
|
|
PERL_ARGS_ASSERT_HFREEENTRIES; |
1651
|
|
|
|
|
|
|
1652
|
214599825
|
100
|
|
|
|
while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) { |
|
|
50
|
|
|
|
|
1653
|
21260664
|
|
|
|
|
SvREFCNT_dec(sv); |
1654
|
|
|
|
|
|
} |
1655
|
128932480
|
|
|
|
|
} |
1656
|
|
|
|
|
|
|
1657
|
|
|
|
|
|
|
1658
|
|
|
|
|
|
/* hfree_next_entry() |
1659
|
|
|
|
|
|
* For use only by S_hfreeentries() and sv_clear(). |
1660
|
|
|
|
|
|
* Delete the next available HE from hv and return the associated SV. |
1661
|
|
|
|
|
|
* Returns null on empty hash. Nevertheless null is not a reliable |
1662
|
|
|
|
|
|
* indicator that the hash is empty, as the deleted entry may have a |
1663
|
|
|
|
|
|
* null value. |
1664
|
|
|
|
|
|
* indexp is a pointer to the current index into HvARRAY. The index should |
1665
|
|
|
|
|
|
* initially be set to 0. hfree_next_entry() may update it. */ |
1666
|
|
|
|
|
|
|
1667
|
|
|
|
|
|
SV* |
1668
|
660096313
|
|
|
|
|
Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp) |
1669
|
|
|
|
|
|
{ |
1670
|
|
|
|
|
|
struct xpvhv_aux *iter; |
1671
|
|
|
|
|
|
HE *entry; |
1672
|
|
|
|
|
|
HE ** array; |
1673
|
|
|
|
|
|
#ifdef DEBUGGING |
1674
|
|
|
|
|
|
STRLEN orig_index = *indexp; |
1675
|
|
|
|
|
|
#endif |
1676
|
|
|
|
|
|
|
1677
|
|
|
|
|
|
PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY; |
1678
|
|
|
|
|
|
|
1679
|
660096313
|
100
|
|
|
|
if (SvOOK(hv) && ((iter = HvAUX(hv)))) { |
|
|
50
|
|
|
|
|
1680
|
106802096
|
100
|
|
|
|
if ((entry = iter->xhv_eiter)) { |
1681
|
|
|
|
|
|
/* the iterator may get resurrected after each |
1682
|
|
|
|
|
|
* destructor call, so check each time */ |
1683
|
142
|
50
|
|
|
|
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ |
|
|
100
|
|
|
|
|
1684
|
20
|
|
|
|
|
HvLAZYDEL_off(hv); |
1685
|
20
|
|
|
|
|
hv_free_ent(hv, entry); |
1686
|
|
|
|
|
|
/* warning: at this point HvARRAY may have been |
1687
|
|
|
|
|
|
* re-allocated, HvMAX changed etc */ |
1688
|
|
|
|
|
|
} |
1689
|
142
|
|
|
|
|
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ |
1690
|
142
|
|
|
|
|
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ |
1691
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
1692
|
142
|
|
|
|
|
iter->xhv_last_rand = iter->xhv_rand; |
1693
|
|
|
|
|
|
#endif |
1694
|
|
|
|
|
|
} |
1695
|
|
|
|
|
|
/* Reset any cached HvFILL() to "unknown". It's unlikely that anyone |
1696
|
|
|
|
|
|
will actually call HvFILL() on a hash under destruction, so it |
1697
|
|
|
|
|
|
seems pointless attempting to track the number of keys remaining. |
1698
|
|
|
|
|
|
But if they do, we want to reset it again. */ |
1699
|
106802096
|
100
|
|
|
|
if (iter->xhv_fill_lazy) |
1700
|
15182
|
|
|
|
|
iter->xhv_fill_lazy = 0; |
1701
|
|
|
|
|
|
} |
1702
|
|
|
|
|
|
|
1703
|
660096313
|
100
|
|
|
|
if (!((XPVHV*)SvANY(hv))->xhv_keys) |
1704
|
|
|
|
|
|
return NULL; |
1705
|
|
|
|
|
|
|
1706
|
429422578
|
|
|
|
|
array = HvARRAY(hv); |
1707
|
|
|
|
|
|
assert(array); |
1708
|
1575527158
|
100
|
|
|
|
while ( ! ((entry = array[*indexp])) ) { |
1709
|
716682002
|
100
|
|
|
|
if ((*indexp)++ >= HvMAX(hv)) |
1710
|
214825741
|
|
|
|
|
*indexp = 0; |
1711
|
|
|
|
|
|
assert(*indexp != orig_index); |
1712
|
|
|
|
|
|
} |
1713
|
429422578
|
|
|
|
|
array[*indexp] = HeNEXT(entry); |
1714
|
429422578
|
|
|
|
|
((XPVHV*) SvANY(hv))->xhv_keys--; |
1715
|
|
|
|
|
|
|
1716
|
429422578
|
100
|
|
|
|
if ( PL_phase != PERL_PHASE_DESTRUCT && HvENAME(hv) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1717
|
2342
|
50
|
|
|
|
&& HeVAL(entry) && isGV(HeVAL(entry)) |
|
|
50
|
|
|
|
|
1718
|
2342
|
100
|
|
|
|
&& GvHV(HeVAL(entry)) && HvENAME(GvHV(HeVAL(entry))) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1719
|
|
|
|
|
|
) { |
1720
|
|
|
|
|
|
STRLEN klen; |
1721
|
368
|
50
|
|
|
|
const char * const key = HePV(entry,klen); |
|
|
0
|
|
|
|
|
1722
|
368
|
50
|
|
|
|
if ((klen > 1 && key[klen-1]==':' && key[klen-2]==':') |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
1723
|
0
|
0
|
|
|
|
|| (klen == 1 && key[0] == ':')) { |
|
|
0
|
|
|
|
|
1724
|
368
|
|
|
|
|
mro_package_moved( |
1725
|
|
|
|
|
|
NULL, GvHV(HeVAL(entry)), |
1726
|
|
|
|
|
|
(GV *)HeVAL(entry), 0 |
1727
|
|
|
|
|
|
); |
1728
|
|
|
|
|
|
} |
1729
|
|
|
|
|
|
} |
1730
|
544851755
|
|
|
|
|
return hv_free_ent_ret(hv, entry); |
1731
|
|
|
|
|
|
} |
1732
|
|
|
|
|
|
|
1733
|
|
|
|
|
|
|
1734
|
|
|
|
|
|
/* |
1735
|
|
|
|
|
|
=for apidoc hv_undef |
1736
|
|
|
|
|
|
|
1737
|
|
|
|
|
|
Undefines the hash. The XS equivalent of C. |
1738
|
|
|
|
|
|
|
1739
|
|
|
|
|
|
As well as freeing all the elements of the hash (like hv_clear()), this |
1740
|
|
|
|
|
|
also frees any auxiliary data and storage associated with the hash. |
1741
|
|
|
|
|
|
|
1742
|
|
|
|
|
|
If any destructors are triggered as a result, the hv itself may |
1743
|
|
|
|
|
|
be freed. |
1744
|
|
|
|
|
|
|
1745
|
|
|
|
|
|
See also L. |
1746
|
|
|
|
|
|
|
1747
|
|
|
|
|
|
=cut |
1748
|
|
|
|
|
|
*/ |
1749
|
|
|
|
|
|
|
1750
|
|
|
|
|
|
void |
1751
|
112050944
|
|
|
|
|
Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags) |
1752
|
|
|
|
|
|
{ |
1753
|
|
|
|
|
|
dVAR; |
1754
|
|
|
|
|
|
XPVHV* xhv; |
1755
|
|
|
|
|
|
const char *name; |
1756
|
112050944
|
|
|
|
|
const bool save = !!SvREFCNT(hv); |
1757
|
|
|
|
|
|
|
1758
|
112050944
|
50
|
|
|
|
if (!hv) |
1759
|
112050944
|
|
|
|
|
return; |
1760
|
|
|
|
|
|
DEBUG_A(Perl_hv_assert(aTHX_ hv)); |
1761
|
112050944
|
|
|
|
|
xhv = (XPVHV*)SvANY(hv); |
1762
|
|
|
|
|
|
|
1763
|
|
|
|
|
|
/* The name must be deleted before the call to hfreeeeentries so that |
1764
|
|
|
|
|
|
CVs are anonymised properly. But the effective name must be pre- |
1765
|
|
|
|
|
|
served until after that call (and only deleted afterwards if the |
1766
|
|
|
|
|
|
call originated from sv_clear). For stashes with one name that is |
1767
|
|
|
|
|
|
both the canonical name and the effective name, hv_name_set has to |
1768
|
|
|
|
|
|
allocate an array for storing the effective name. We can skip that |
1769
|
|
|
|
|
|
during global destruction, as it does not matter where the CVs point |
1770
|
|
|
|
|
|
if they will be freed anyway. */ |
1771
|
|
|
|
|
|
/* note that the code following prior to hfreeentries is duplicated |
1772
|
|
|
|
|
|
* in sv_clear(), and changes here should be done there too */ |
1773
|
112050944
|
100
|
|
|
|
if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
1774
|
314
|
50
|
|
|
|
if (PL_stashcache) { |
1775
|
|
|
|
|
|
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for '%" |
1776
|
|
|
|
|
|
HEKf"'\n", HvNAME_HEK(hv))); |
1777
|
314
|
50
|
|
|
|
(void)hv_delete(PL_stashcache, name, |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1778
|
|
|
|
|
|
HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv), |
1779
|
|
|
|
|
|
G_DISCARD |
1780
|
|
|
|
|
|
); |
1781
|
|
|
|
|
|
} |
1782
|
314
|
|
|
|
|
hv_name_set(hv, NULL, 0, 0); |
1783
|
|
|
|
|
|
} |
1784
|
112050944
|
100
|
|
|
|
if (save) { |
1785
|
2780130
|
|
|
|
|
ENTER; |
1786
|
2780130
|
|
|
|
|
SAVEFREESV(SvREFCNT_inc_simple_NN(hv)); |
1787
|
|
|
|
|
|
} |
1788
|
112050944
|
|
|
|
|
hfreeentries(hv); |
1789
|
112050944
|
100
|
|
|
|
if (SvOOK(hv)) { |
1790
|
16876529
|
|
|
|
|
struct xpvhv_aux * const aux = HvAUX(hv); |
1791
|
|
|
|
|
|
struct mro_meta *meta; |
1792
|
|
|
|
|
|
|
1793
|
16876529
|
50
|
|
|
|
if ((name = HvENAME_get(hv))) { |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1794
|
422
|
100
|
|
|
|
if (PL_phase != PERL_PHASE_DESTRUCT) |
1795
|
418
|
|
|
|
|
mro_isa_changed_in(hv); |
1796
|
422
|
50
|
|
|
|
if (PL_stashcache) { |
1797
|
|
|
|
|
|
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for effective name '%" |
1798
|
|
|
|
|
|
HEKf"'\n", HvENAME_HEK(hv))); |
1799
|
422
|
50
|
|
|
|
(void)hv_delete( |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
1800
|
|
|
|
|
|
PL_stashcache, name, |
1801
|
|
|
|
|
|
HEK_UTF8(HvENAME_HEK(hv)) ? -HvENAMELEN_get(hv) : HvENAMELEN_get(hv), |
1802
|
|
|
|
|
|
G_DISCARD |
1803
|
|
|
|
|
|
); |
1804
|
|
|
|
|
|
} |
1805
|
|
|
|
|
|
} |
1806
|
|
|
|
|
|
|
1807
|
|
|
|
|
|
/* If this call originated from sv_clear, then we must check for |
1808
|
|
|
|
|
|
* effective names that need freeing, as well as the usual name. */ |
1809
|
16876529
|
50
|
|
|
|
name = HvNAME(hv); |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1810
|
16876529
|
100
|
|
|
|
if (flags & HV_NAME_SETALL ? !!aux->xhv_name_u.xhvnameu_name : !!name) { |
|
|
100
|
|
|
|
|
1811
|
836
|
100
|
|
|
|
if (name && PL_stashcache) { |
|
|
50
|
|
|
|
|
1812
|
|
|
|
|
|
DEBUG_o(Perl_deb(aTHX_ "hv_undef_flags clearing PL_stashcache for name '%" |
1813
|
|
|
|
|
|
HEKf"'\n", HvNAME_HEK(hv))); |
1814
|
22
|
50
|
|
|
|
(void)hv_delete(PL_stashcache, name, (HEK_UTF8(HvNAME_HEK(hv)) ? -HvNAMELEN_get(hv) : HvNAMELEN_get(hv)), G_DISCARD); |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
1815
|
|
|
|
|
|
} |
1816
|
836
|
|
|
|
|
hv_name_set(hv, NULL, 0, flags); |
1817
|
|
|
|
|
|
} |
1818
|
16876529
|
100
|
|
|
|
if((meta = aux->xhv_mro_meta)) { |
1819
|
860
|
50
|
|
|
|
if (meta->mro_linear_all) { |
1820
|
0
|
|
|
|
|
SvREFCNT_dec_NN(meta->mro_linear_all); |
1821
|
|
|
|
|
|
/* mro_linear_current is just acting as a shortcut pointer, |
1822
|
|
|
|
|
|
hence the else. */ |
1823
|
|
|
|
|
|
} |
1824
|
|
|
|
|
|
else |
1825
|
|
|
|
|
|
/* Only the current MRO is stored, so this owns the data. |
1826
|
|
|
|
|
|
*/ |
1827
|
860
|
|
|
|
|
SvREFCNT_dec(meta->mro_linear_current); |
1828
|
860
|
|
|
|
|
SvREFCNT_dec(meta->mro_nextmethod); |
1829
|
860
|
|
|
|
|
SvREFCNT_dec(meta->isa); |
1830
|
860
|
|
|
|
|
SvREFCNT_dec(meta->super); |
1831
|
860
|
|
|
|
|
Safefree(meta); |
1832
|
860
|
|
|
|
|
aux->xhv_mro_meta = NULL; |
1833
|
|
|
|
|
|
} |
1834
|
16876529
|
100
|
|
|
|
if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences) |
|
|
100
|
|
|
|
|
1835
|
16876491
|
|
|
|
|
SvFLAGS(hv) &= ~SVf_OOK; |
1836
|
|
|
|
|
|
} |
1837
|
112050944
|
100
|
|
|
|
if (!SvOOK(hv)) { |
1838
|
112050906
|
|
|
|
|
Safefree(HvARRAY(hv)); |
1839
|
112050906
|
|
|
|
|
xhv->xhv_max = PERL_HASH_DEFAULT_HvMAX; /* HvMAX(hv) = 7 (it's a normal hash) */ |
1840
|
112050906
|
|
|
|
|
HvARRAY(hv) = 0; |
1841
|
|
|
|
|
|
} |
1842
|
|
|
|
|
|
/* if we're freeing the HV, the SvMAGIC field has been reused for |
1843
|
|
|
|
|
|
* other purposes, and so there can't be any placeholder magic */ |
1844
|
112050944
|
100
|
|
|
|
if (SvREFCNT(hv)) |
1845
|
2780130
|
|
|
|
|
HvPLACEHOLDERS_set(hv, 0); |
1846
|
|
|
|
|
|
|
1847
|
112050944
|
100
|
|
|
|
if (SvRMAGICAL(hv)) |
1848
|
4
|
|
|
|
|
mg_clear(MUTABLE_SV(hv)); |
1849
|
112050944
|
100
|
|
|
|
if (save) LEAVE; |
1850
|
|
|
|
|
|
} |
1851
|
|
|
|
|
|
|
1852
|
|
|
|
|
|
/* |
1853
|
|
|
|
|
|
=for apidoc hv_fill |
1854
|
|
|
|
|
|
|
1855
|
|
|
|
|
|
Returns the number of hash buckets that happen to be in use. This function is |
1856
|
|
|
|
|
|
wrapped by the macro C. |
1857
|
|
|
|
|
|
|
1858
|
|
|
|
|
|
Previously this value was always stored in the HV structure, which created an |
1859
|
|
|
|
|
|
overhead on every hash (and pretty much every object) for something that was |
1860
|
|
|
|
|
|
rarely used. Now we calculate it on demand the first time that it is needed, |
1861
|
|
|
|
|
|
and cache it if that calculation is going to be costly to repeat. The cached |
1862
|
|
|
|
|
|
value is updated by insertions and deletions, but (currently) discarded if |
1863
|
|
|
|
|
|
the hash is split. |
1864
|
|
|
|
|
|
|
1865
|
|
|
|
|
|
=cut |
1866
|
|
|
|
|
|
*/ |
1867
|
|
|
|
|
|
|
1868
|
|
|
|
|
|
STRLEN |
1869
|
109227
|
|
|
|
|
Perl_hv_fill(pTHX_ HV *const hv) |
1870
|
|
|
|
|
|
{ |
1871
|
|
|
|
|
|
STRLEN count = 0; |
1872
|
109227
|
|
|
|
|
HE **ents = HvARRAY(hv); |
1873
|
109227
|
100
|
|
|
|
struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : NULL; |
1874
|
|
|
|
|
|
|
1875
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_FILL; |
1876
|
|
|
|
|
|
|
1877
|
|
|
|
|
|
/* No keys implies no buckets used. |
1878
|
|
|
|
|
|
One key can only possibly mean one bucket used. */ |
1879
|
109227
|
100
|
|
|
|
if (HvTOTALKEYS(hv) < 2) |
1880
|
1124
|
|
|
|
|
return HvTOTALKEYS(hv); |
1881
|
|
|
|
|
|
|
1882
|
|
|
|
|
|
#ifndef DEBUGGING |
1883
|
108103
|
100
|
|
|
|
if (aux && aux->xhv_fill_lazy) |
|
|
100
|
|
|
|
|
1884
|
51238
|
|
|
|
|
return aux->xhv_fill_lazy; |
1885
|
|
|
|
|
|
#endif |
1886
|
|
|
|
|
|
|
1887
|
56865
|
50
|
|
|
|
if (ents) { |
1888
|
56865
|
|
|
|
|
HE *const *const last = ents + HvMAX(hv); |
1889
|
56865
|
|
|
|
|
count = last + 1 - ents; |
1890
|
|
|
|
|
|
|
1891
|
|
|
|
|
|
do { |
1892
|
9408208
|
100
|
|
|
|
if (!*ents) |
1893
|
4982208
|
|
|
|
|
--count; |
1894
|
9408208
|
100
|
|
|
|
} while (++ents <= last); |
1895
|
|
|
|
|
|
} |
1896
|
56865
|
100
|
|
|
|
if (aux) { |
1897
|
|
|
|
|
|
#ifdef DEBUGGING |
1898
|
|
|
|
|
|
if (aux->xhv_fill_lazy) |
1899
|
|
|
|
|
|
assert(aux->xhv_fill_lazy == count); |
1900
|
|
|
|
|
|
#endif |
1901
|
38996
|
|
|
|
|
aux->xhv_fill_lazy = count; |
1902
|
17869
|
100
|
|
|
|
} else if (HvMAX(hv) >= HV_FILL_THRESHOLD) { |
1903
|
11125
|
|
|
|
|
aux = hv_auxinit(hv); |
1904
|
62696
|
|
|
|
|
aux->xhv_fill_lazy = count; |
1905
|
|
|
|
|
|
} |
1906
|
|
|
|
|
|
return count; |
1907
|
|
|
|
|
|
} |
1908
|
|
|
|
|
|
|
1909
|
|
|
|
|
|
/* hash a pointer to a U32 - Used in the hash traversal randomization |
1910
|
|
|
|
|
|
* and bucket order randomization code |
1911
|
|
|
|
|
|
* |
1912
|
|
|
|
|
|
* this code was derived from Sereal, which was derived from autobox. |
1913
|
|
|
|
|
|
*/ |
1914
|
|
|
|
|
|
|
1915
|
|
|
|
|
|
PERL_STATIC_INLINE U32 S_ptr_hash(PTRV u) { |
1916
|
|
|
|
|
|
#if PTRSIZE == 8 |
1917
|
|
|
|
|
|
/* |
1918
|
|
|
|
|
|
* This is one of Thomas Wang's hash functions for 64-bit integers from: |
1919
|
|
|
|
|
|
* http://www.concentric.net/~Ttwang/tech/inthash.htm |
1920
|
|
|
|
|
|
*/ |
1921
|
29311986
|
|
|
|
|
u = (~u) + (u << 18); |
1922
|
29311986
|
|
|
|
|
u = u ^ (u >> 31); |
1923
|
29311986
|
|
|
|
|
u = u * 21; |
1924
|
29311986
|
|
|
|
|
u = u ^ (u >> 11); |
1925
|
29311986
|
|
|
|
|
u = u + (u << 6); |
1926
|
29311986
|
|
|
|
|
u = u ^ (u >> 22); |
1927
|
|
|
|
|
|
#else |
1928
|
|
|
|
|
|
/* |
1929
|
|
|
|
|
|
* This is one of Bob Jenkins' hash functions for 32-bit integers |
1930
|
|
|
|
|
|
* from: http://burtleburtle.net/bob/hash/integer.html |
1931
|
|
|
|
|
|
*/ |
1932
|
|
|
|
|
|
u = (u + 0x7ed55d16) + (u << 12); |
1933
|
|
|
|
|
|
u = (u ^ 0xc761c23c) ^ (u >> 19); |
1934
|
|
|
|
|
|
u = (u + 0x165667b1) + (u << 5); |
1935
|
|
|
|
|
|
u = (u + 0xd3a2646c) ^ (u << 9); |
1936
|
|
|
|
|
|
u = (u + 0xfd7046c5) + (u << 3); |
1937
|
|
|
|
|
|
u = (u ^ 0xb55a4f09) ^ (u >> 16); |
1938
|
|
|
|
|
|
#endif |
1939
|
29311986
|
|
|
|
|
return (U32)u; |
1940
|
|
|
|
|
|
} |
1941
|
|
|
|
|
|
|
1942
|
|
|
|
|
|
|
1943
|
|
|
|
|
|
static struct xpvhv_aux* |
1944
|
20064292
|
|
|
|
|
S_hv_auxinit(pTHX_ HV *hv) { |
1945
|
|
|
|
|
|
struct xpvhv_aux *iter; |
1946
|
|
|
|
|
|
char *array; |
1947
|
|
|
|
|
|
|
1948
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_AUXINIT; |
1949
|
|
|
|
|
|
|
1950
|
20064292
|
50
|
|
|
|
if (!SvOOK(hv)) { |
1951
|
20064292
|
100
|
|
|
|
if (!HvARRAY(hv)) { |
1952
|
2274333
|
|
|
|
|
Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1) |
1953
|
|
|
|
|
|
+ sizeof(struct xpvhv_aux), char); |
1954
|
|
|
|
|
|
} else { |
1955
|
17789959
|
|
|
|
|
array = (char *) HvARRAY(hv); |
1956
|
17789959
|
|
|
|
|
Renew(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1) |
1957
|
|
|
|
|
|
+ sizeof(struct xpvhv_aux), char); |
1958
|
|
|
|
|
|
} |
1959
|
20064292
|
|
|
|
|
HvARRAY(hv) = (HE**)array; |
1960
|
20064292
|
|
|
|
|
SvOOK_on(hv); |
1961
|
20064292
|
|
|
|
|
iter = HvAUX(hv); |
1962
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
1963
|
20064292
|
100
|
|
|
|
if (PL_HASH_RAND_BITS_ENABLED) { |
1964
|
|
|
|
|
|
/* mix in some new state to PL_hash_rand_bits to "randomize" the traversal order*/ |
1965
|
20064208
|
100
|
|
|
|
if (PL_HASH_RAND_BITS_ENABLED == 1) |
1966
|
30048667
|
|
|
|
|
PL_hash_rand_bits += ptr_hash((PTRV)array); |
1967
|
20064208
|
|
|
|
|
PL_hash_rand_bits = ROTL_UV(PL_hash_rand_bits,1); |
1968
|
|
|
|
|
|
} |
1969
|
20064292
|
|
|
|
|
iter->xhv_rand = (U32)PL_hash_rand_bits; |
1970
|
|
|
|
|
|
#endif |
1971
|
|
|
|
|
|
} else { |
1972
|
0
|
|
|
|
|
iter = HvAUX(hv); |
1973
|
|
|
|
|
|
} |
1974
|
|
|
|
|
|
|
1975
|
20064292
|
|
|
|
|
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ |
1976
|
20064292
|
|
|
|
|
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ |
1977
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
1978
|
20064292
|
|
|
|
|
iter->xhv_last_rand = iter->xhv_rand; |
1979
|
|
|
|
|
|
#endif |
1980
|
20064292
|
|
|
|
|
iter->xhv_fill_lazy = 0; |
1981
|
20064292
|
|
|
|
|
iter->xhv_name_u.xhvnameu_name = 0; |
1982
|
20064292
|
|
|
|
|
iter->xhv_name_count = 0; |
1983
|
20064292
|
|
|
|
|
iter->xhv_backreferences = 0; |
1984
|
20064292
|
|
|
|
|
iter->xhv_mro_meta = NULL; |
1985
|
20064292
|
|
|
|
|
return iter; |
1986
|
|
|
|
|
|
} |
1987
|
|
|
|
|
|
|
1988
|
|
|
|
|
|
/* |
1989
|
|
|
|
|
|
=for apidoc hv_iterinit |
1990
|
|
|
|
|
|
|
1991
|
|
|
|
|
|
Prepares a starting point to traverse a hash table. Returns the number of |
1992
|
|
|
|
|
|
keys in the hash (i.e. the same as C). The return value is |
1993
|
|
|
|
|
|
currently only meaningful for hashes without tie magic. |
1994
|
|
|
|
|
|
|
1995
|
|
|
|
|
|
NOTE: Before version 5.004_65, C used to return the number of |
1996
|
|
|
|
|
|
hash buckets that happen to be in use. If you still need that esoteric |
1997
|
|
|
|
|
|
value, you can get it through the macro C. |
1998
|
|
|
|
|
|
|
1999
|
|
|
|
|
|
|
2000
|
|
|
|
|
|
=cut |
2001
|
|
|
|
|
|
*/ |
2002
|
|
|
|
|
|
|
2003
|
|
|
|
|
|
I32 |
2004
|
29854094
|
|
|
|
|
Perl_hv_iterinit(pTHX_ HV *hv) |
2005
|
|
|
|
|
|
{ |
2006
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ITERINIT; |
2007
|
|
|
|
|
|
|
2008
|
|
|
|
|
|
/* FIXME: Are we not NULL, or do we croak? Place bets now! */ |
2009
|
|
|
|
|
|
|
2010
|
29854094
|
50
|
|
|
|
if (!hv) |
2011
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2012
|
|
|
|
|
|
|
2013
|
29854094
|
100
|
|
|
|
if (SvOOK(hv)) { |
2014
|
11425676
|
|
|
|
|
struct xpvhv_aux * const iter = HvAUX(hv); |
2015
|
11425676
|
|
|
|
|
HE * const entry = iter->xhv_eiter; /* HvEITER(hv) */ |
2016
|
11425676
|
100
|
|
|
|
if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */ |
|
|
100
|
|
|
|
|
2017
|
8
|
|
|
|
|
HvLAZYDEL_off(hv); |
2018
|
8
|
|
|
|
|
hv_free_ent(hv, entry); |
2019
|
|
|
|
|
|
} |
2020
|
11425676
|
|
|
|
|
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ |
2021
|
11425676
|
|
|
|
|
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ |
2022
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
2023
|
11425676
|
|
|
|
|
iter->xhv_last_rand = iter->xhv_rand; |
2024
|
|
|
|
|
|
#endif |
2025
|
|
|
|
|
|
} else { |
2026
|
18428418
|
|
|
|
|
hv_auxinit(hv); |
2027
|
|
|
|
|
|
} |
2028
|
|
|
|
|
|
|
2029
|
|
|
|
|
|
/* used to be xhv->xhv_fill before 5.004_65 */ |
2030
|
29854094
|
|
|
|
|
return HvTOTALKEYS(hv); |
2031
|
|
|
|
|
|
} |
2032
|
|
|
|
|
|
|
2033
|
|
|
|
|
|
I32 * |
2034
|
0
|
|
|
|
|
Perl_hv_riter_p(pTHX_ HV *hv) { |
2035
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2036
|
|
|
|
|
|
|
2037
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_RITER_P; |
2038
|
|
|
|
|
|
|
2039
|
0
|
0
|
|
|
|
if (!hv) |
2040
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2041
|
|
|
|
|
|
|
2042
|
0
|
0
|
|
|
|
iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); |
2043
|
0
|
|
|
|
|
return &(iter->xhv_riter); |
2044
|
|
|
|
|
|
} |
2045
|
|
|
|
|
|
|
2046
|
|
|
|
|
|
HE ** |
2047
|
2
|
|
|
|
|
Perl_hv_eiter_p(pTHX_ HV *hv) { |
2048
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2049
|
|
|
|
|
|
|
2050
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_EITER_P; |
2051
|
|
|
|
|
|
|
2052
|
2
|
50
|
|
|
|
if (!hv) |
2053
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2054
|
|
|
|
|
|
|
2055
|
2
|
50
|
|
|
|
iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); |
2056
|
2
|
|
|
|
|
return &(iter->xhv_eiter); |
2057
|
|
|
|
|
|
} |
2058
|
|
|
|
|
|
|
2059
|
|
|
|
|
|
void |
2060
|
15784077
|
|
|
|
|
Perl_hv_riter_set(pTHX_ HV *hv, I32 riter) { |
2061
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2062
|
|
|
|
|
|
|
2063
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_RITER_SET; |
2064
|
|
|
|
|
|
|
2065
|
15784077
|
50
|
|
|
|
if (!hv) |
2066
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2067
|
|
|
|
|
|
|
2068
|
15784077
|
50
|
|
|
|
if (SvOOK(hv)) { |
2069
|
15784077
|
|
|
|
|
iter = HvAUX(hv); |
2070
|
|
|
|
|
|
} else { |
2071
|
0
|
0
|
|
|
|
if (riter == -1) |
2072
|
15784077
|
|
|
|
|
return; |
2073
|
|
|
|
|
|
|
2074
|
0
|
|
|
|
|
iter = hv_auxinit(hv); |
2075
|
|
|
|
|
|
} |
2076
|
15784077
|
|
|
|
|
iter->xhv_riter = riter; |
2077
|
|
|
|
|
|
} |
2078
|
|
|
|
|
|
|
2079
|
|
|
|
|
|
void |
2080
|
0
|
|
|
|
|
Perl_hv_rand_set(pTHX_ HV *hv, U32 new_xhv_rand) { |
2081
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2082
|
|
|
|
|
|
|
2083
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_RAND_SET; |
2084
|
|
|
|
|
|
|
2085
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
2086
|
0
|
0
|
|
|
|
if (!hv) |
2087
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2088
|
|
|
|
|
|
|
2089
|
0
|
0
|
|
|
|
if (SvOOK(hv)) { |
2090
|
0
|
|
|
|
|
iter = HvAUX(hv); |
2091
|
|
|
|
|
|
} else { |
2092
|
0
|
|
|
|
|
iter = hv_auxinit(hv); |
2093
|
|
|
|
|
|
} |
2094
|
0
|
|
|
|
|
iter->xhv_rand = new_xhv_rand; |
2095
|
|
|
|
|
|
#else |
2096
|
|
|
|
|
|
Perl_croak(aTHX_ "This Perl has not been built with support for randomized hash key traversal but something called Perl_hv_rand_set()."); |
2097
|
|
|
|
|
|
#endif |
2098
|
0
|
|
|
|
|
} |
2099
|
|
|
|
|
|
|
2100
|
|
|
|
|
|
void |
2101
|
16504911
|
|
|
|
|
Perl_hv_eiter_set(pTHX_ HV *hv, HE *eiter) { |
2102
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2103
|
|
|
|
|
|
|
2104
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_EITER_SET; |
2105
|
|
|
|
|
|
|
2106
|
16504911
|
50
|
|
|
|
if (!hv) |
2107
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2108
|
|
|
|
|
|
|
2109
|
16504911
|
100
|
|
|
|
if (SvOOK(hv)) { |
2110
|
16484639
|
|
|
|
|
iter = HvAUX(hv); |
2111
|
|
|
|
|
|
} else { |
2112
|
|
|
|
|
|
/* 0 is the default so don't go malloc()ing a new structure just to |
2113
|
|
|
|
|
|
hold 0. */ |
2114
|
20272
|
50
|
|
|
|
if (!eiter) |
2115
|
16504911
|
|
|
|
|
return; |
2116
|
|
|
|
|
|
|
2117
|
0
|
|
|
|
|
iter = hv_auxinit(hv); |
2118
|
|
|
|
|
|
} |
2119
|
16484639
|
|
|
|
|
iter->xhv_eiter = eiter; |
2120
|
|
|
|
|
|
} |
2121
|
|
|
|
|
|
|
2122
|
|
|
|
|
|
void |
2123
|
1626451
|
|
|
|
|
Perl_hv_name_set(pTHX_ HV *hv, const char *name, U32 len, U32 flags) |
2124
|
|
|
|
|
|
{ |
2125
|
|
|
|
|
|
dVAR; |
2126
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2127
|
|
|
|
|
|
U32 hash; |
2128
|
|
|
|
|
|
HEK **spot; |
2129
|
|
|
|
|
|
|
2130
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_NAME_SET; |
2131
|
|
|
|
|
|
|
2132
|
1626451
|
50
|
|
|
|
if (len > I32_MAX) |
2133
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len); |
2134
|
|
|
|
|
|
|
2135
|
1626451
|
100
|
|
|
|
if (SvOOK(hv)) { |
2136
|
26120
|
|
|
|
|
iter = HvAUX(hv); |
2137
|
26120
|
100
|
|
|
|
if (iter->xhv_name_u.xhvnameu_name) { |
2138
|
1774
|
100
|
|
|
|
if(iter->xhv_name_count) { |
2139
|
1356
|
100
|
|
|
|
if(flags & HV_NAME_SETALL) { |
2140
|
820
|
|
|
|
|
HEK ** const name = HvAUX(hv)->xhv_name_u.xhvnameu_names; |
2141
|
1230
|
50
|
|
|
|
HEK **hekp = name + ( |
2142
|
820
|
|
|
|
|
iter->xhv_name_count < 0 |
2143
|
820
|
|
|
|
|
? -iter->xhv_name_count |
2144
|
0
|
|
|
|
|
: iter->xhv_name_count |
2145
|
|
|
|
|
|
); |
2146
|
1656
|
100
|
|
|
|
while(hekp-- > name+1) |
2147
|
426
|
|
|
|
|
unshare_hek_or_pvn(*hekp, 0, 0, 0); |
2148
|
|
|
|
|
|
/* The first elem may be null. */ |
2149
|
820
|
100
|
|
|
|
if(*name) unshare_hek_or_pvn(*name, 0, 0, 0); |
2150
|
820
|
|
|
|
|
Safefree(name); |
2151
|
820
|
|
|
|
|
spot = &iter->xhv_name_u.xhvnameu_name; |
2152
|
820
|
|
|
|
|
iter->xhv_name_count = 0; |
2153
|
|
|
|
|
|
} |
2154
|
|
|
|
|
|
else { |
2155
|
536
|
100
|
|
|
|
if(iter->xhv_name_count > 0) { |
2156
|
|
|
|
|
|
/* shift some things over */ |
2157
|
72
|
50
|
|
|
|
Renew( |
2158
|
|
|
|
|
|
iter->xhv_name_u.xhvnameu_names, iter->xhv_name_count + 1, HEK * |
2159
|
|
|
|
|
|
); |
2160
|
48
|
|
|
|
|
spot = iter->xhv_name_u.xhvnameu_names; |
2161
|
48
|
|
|
|
|
spot[iter->xhv_name_count] = spot[1]; |
2162
|
48
|
|
|
|
|
spot[1] = spot[0]; |
2163
|
48
|
|
|
|
|
iter->xhv_name_count = -(iter->xhv_name_count + 1); |
2164
|
|
|
|
|
|
} |
2165
|
488
|
100
|
|
|
|
else if(*(spot = iter->xhv_name_u.xhvnameu_names)) { |
2166
|
444
|
|
|
|
|
unshare_hek_or_pvn(*spot, 0, 0, 0); |
2167
|
|
|
|
|
|
} |
2168
|
|
|
|
|
|
} |
2169
|
|
|
|
|
|
} |
2170
|
418
|
100
|
|
|
|
else if (flags & HV_NAME_SETALL) { |
2171
|
4
|
|
|
|
|
unshare_hek_or_pvn(iter->xhv_name_u.xhvnameu_name, 0, 0, 0); |
2172
|
4
|
|
|
|
|
spot = &iter->xhv_name_u.xhvnameu_name; |
2173
|
|
|
|
|
|
} |
2174
|
|
|
|
|
|
else { |
2175
|
414
|
|
|
|
|
HEK * const existing_name = iter->xhv_name_u.xhvnameu_name; |
2176
|
414
|
|
|
|
|
Newx(iter->xhv_name_u.xhvnameu_names, 2, HEK *); |
2177
|
414
|
|
|
|
|
iter->xhv_name_count = -2; |
2178
|
414
|
|
|
|
|
spot = iter->xhv_name_u.xhvnameu_names; |
2179
|
414
|
|
|
|
|
spot[1] = existing_name; |
2180
|
|
|
|
|
|
} |
2181
|
|
|
|
|
|
} |
2182
|
24346
|
|
|
|
|
else { spot = &iter->xhv_name_u.xhvnameu_name; iter->xhv_name_count = 0; } |
2183
|
|
|
|
|
|
} else { |
2184
|
1600331
|
50
|
|
|
|
if (name == 0) |
2185
|
1626451
|
|
|
|
|
return; |
2186
|
|
|
|
|
|
|
2187
|
1600331
|
|
|
|
|
iter = hv_auxinit(hv); |
2188
|
1600331
|
|
|
|
|
spot = &iter->xhv_name_u.xhvnameu_name; |
2189
|
|
|
|
|
|
} |
2190
|
1626451
|
|
|
|
|
PERL_HASH(hash, name, len); |
2191
|
1626451
|
100
|
|
|
|
*spot = name ? share_hek(name, flags & SVf_UTF8 ? -(I32)len : (I32)len, hash) : NULL; |
|
|
100
|
|
|
|
|
2192
|
|
|
|
|
|
} |
2193
|
|
|
|
|
|
|
2194
|
|
|
|
|
|
/* |
2195
|
|
|
|
|
|
This is basically sv_eq_flags() in sv.c, but we avoid the magic |
2196
|
|
|
|
|
|
and bytes checking. |
2197
|
|
|
|
|
|
*/ |
2198
|
|
|
|
|
|
|
2199
|
|
|
|
|
|
STATIC I32 |
2200
|
430
|
|
|
|
|
hek_eq_pvn_flags(pTHX_ const HEK *hek, const char* pv, const I32 pvlen, const U32 flags) { |
2201
|
430
|
100
|
|
|
|
if ( (HEK_UTF8(hek) ? 1 : 0) != (flags & SVf_UTF8 ? 1 : 0) ) { |
2202
|
2
|
50
|
|
|
|
if (flags & SVf_UTF8) |
2203
|
0
|
|
|
|
|
return (bytes_cmp_utf8( |
2204
|
|
|
|
|
|
(const U8*)HEK_KEY(hek), HEK_LEN(hek), |
2205
|
|
|
|
|
|
(const U8*)pv, pvlen) == 0); |
2206
|
|
|
|
|
|
else |
2207
|
2
|
|
|
|
|
return (bytes_cmp_utf8( |
2208
|
|
|
|
|
|
(const U8*)pv, pvlen, |
2209
|
|
|
|
|
|
(const U8*)HEK_KEY(hek), HEK_LEN(hek)) == 0); |
2210
|
|
|
|
|
|
} |
2211
|
|
|
|
|
|
else |
2212
|
857
|
100
|
|
|
|
return HEK_LEN(hek) == pvlen && ((HEK_KEY(hek) == pv) |
|
|
50
|
|
|
|
|
2213
|
314
|
100
|
|
|
|
|| memEQ(HEK_KEY(hek), pv, pvlen)); |
2214
|
|
|
|
|
|
} |
2215
|
|
|
|
|
|
|
2216
|
|
|
|
|
|
/* |
2217
|
|
|
|
|
|
=for apidoc hv_ename_add |
2218
|
|
|
|
|
|
|
2219
|
|
|
|
|
|
Adds a name to a stash's internal list of effective names. See |
2220
|
|
|
|
|
|
C. |
2221
|
|
|
|
|
|
|
2222
|
|
|
|
|
|
This is called when a stash is assigned to a new location in the symbol |
2223
|
|
|
|
|
|
table. |
2224
|
|
|
|
|
|
|
2225
|
|
|
|
|
|
=cut |
2226
|
|
|
|
|
|
*/ |
2227
|
|
|
|
|
|
|
2228
|
|
|
|
|
|
void |
2229
|
704
|
|
|
|
|
Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags) |
2230
|
|
|
|
|
|
{ |
2231
|
|
|
|
|
|
dVAR; |
2232
|
704
|
50
|
|
|
|
struct xpvhv_aux *aux = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); |
2233
|
|
|
|
|
|
U32 hash; |
2234
|
|
|
|
|
|
|
2235
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ENAME_ADD; |
2236
|
|
|
|
|
|
|
2237
|
704
|
50
|
|
|
|
if (len > I32_MAX) |
2238
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len); |
2239
|
|
|
|
|
|
|
2240
|
704
|
|
|
|
|
PERL_HASH(hash, name, len); |
2241
|
|
|
|
|
|
|
2242
|
704
|
100
|
|
|
|
if (aux->xhv_name_count) { |
2243
|
24
|
|
|
|
|
HEK ** const xhv_name = aux->xhv_name_u.xhvnameu_names; |
2244
|
24
|
|
|
|
|
I32 count = aux->xhv_name_count; |
2245
|
24
|
100
|
|
|
|
HEK **hekp = xhv_name + (count < 0 ? -count : count); |
2246
|
66
|
100
|
|
|
|
while (hekp-- > xhv_name) |
2247
|
36
|
100
|
|
|
|
if ( |
2248
|
85
|
100
|
|
|
|
(HEK_UTF8(*hekp) || (flags & SVf_UTF8)) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
2249
|
10
|
|
|
|
|
? hek_eq_pvn_flags(aTHX_ *hekp, name, (I32)len, flags) |
2250
|
32
|
100
|
|
|
|
: (HEK_LEN(*hekp) == (I32)len && memEQ(HEK_KEY(*hekp), name, len)) |
2251
|
|
|
|
|
|
) { |
2252
|
6
|
50
|
|
|
|
if (hekp == xhv_name && count < 0) |
2253
|
6
|
|
|
|
|
aux->xhv_name_count = -count; |
2254
|
|
|
|
|
|
return; |
2255
|
|
|
|
|
|
} |
2256
|
18
|
100
|
|
|
|
if (count < 0) aux->xhv_name_count--, count = -count; |
2257
|
6
|
|
|
|
|
else aux->xhv_name_count++; |
2258
|
27
|
50
|
|
|
|
Renew(aux->xhv_name_u.xhvnameu_names, count + 1, HEK *); |
2259
|
18
|
100
|
|
|
|
(aux->xhv_name_u.xhvnameu_names)[count] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash); |
2260
|
|
|
|
|
|
} |
2261
|
|
|
|
|
|
else { |
2262
|
680
|
|
|
|
|
HEK *existing_name = aux->xhv_name_u.xhvnameu_name; |
2263
|
680
|
50
|
|
|
|
if ( |
2264
|
1768
|
100
|
|
|
|
existing_name && ( |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2265
|
748
|
50
|
|
|
|
(HEK_UTF8(existing_name) || (flags & SVf_UTF8)) |
2266
|
272
|
|
|
|
|
? hek_eq_pvn_flags(aTHX_ existing_name, name, (I32)len, flags) |
2267
|
547
|
100
|
|
|
|
: (HEK_LEN(existing_name) == (I32)len && memEQ(HEK_KEY(existing_name), name, len)) |
2268
|
|
|
|
|
|
) |
2269
|
|
|
|
|
|
) return; |
2270
|
526
|
|
|
|
|
Newx(aux->xhv_name_u.xhvnameu_names, 2, HEK *); |
2271
|
526
|
50
|
|
|
|
aux->xhv_name_count = existing_name ? 2 : -2; |
2272
|
526
|
|
|
|
|
*aux->xhv_name_u.xhvnameu_names = existing_name; |
2273
|
615
|
100
|
|
|
|
(aux->xhv_name_u.xhvnameu_names)[1] = share_hek(name, (flags & SVf_UTF8 ? -(I32)len : (I32)len), hash); |
2274
|
|
|
|
|
|
} |
2275
|
|
|
|
|
|
} |
2276
|
|
|
|
|
|
|
2277
|
|
|
|
|
|
/* |
2278
|
|
|
|
|
|
=for apidoc hv_ename_delete |
2279
|
|
|
|
|
|
|
2280
|
|
|
|
|
|
Removes a name from a stash's internal list of effective names. If this is |
2281
|
|
|
|
|
|
the name returned by C, then another name in the list will take |
2282
|
|
|
|
|
|
its place (C will use it). |
2283
|
|
|
|
|
|
|
2284
|
|
|
|
|
|
This is called when a stash is deleted from the symbol table. |
2285
|
|
|
|
|
|
|
2286
|
|
|
|
|
|
=cut |
2287
|
|
|
|
|
|
*/ |
2288
|
|
|
|
|
|
|
2289
|
|
|
|
|
|
void |
2290
|
532
|
|
|
|
|
Perl_hv_ename_delete(pTHX_ HV *hv, const char *name, U32 len, U32 flags) |
2291
|
|
|
|
|
|
{ |
2292
|
|
|
|
|
|
dVAR; |
2293
|
|
|
|
|
|
struct xpvhv_aux *aux; |
2294
|
|
|
|
|
|
|
2295
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ENAME_DELETE; |
2296
|
|
|
|
|
|
|
2297
|
532
|
50
|
|
|
|
if (len > I32_MAX) |
2298
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: hv name too long (%"UVuf")", (UV) len); |
2299
|
|
|
|
|
|
|
2300
|
532
|
50
|
|
|
|
if (!SvOOK(hv)) return; |
2301
|
|
|
|
|
|
|
2302
|
532
|
|
|
|
|
aux = HvAUX(hv); |
2303
|
532
|
50
|
|
|
|
if (!aux->xhv_name_u.xhvnameu_name) return; |
2304
|
|
|
|
|
|
|
2305
|
532
|
100
|
|
|
|
if (aux->xhv_name_count) { |
2306
|
112
|
|
|
|
|
HEK ** const namep = aux->xhv_name_u.xhvnameu_names; |
2307
|
112
|
|
|
|
|
I32 const count = aux->xhv_name_count; |
2308
|
112
|
100
|
|
|
|
HEK **victim = namep + (count < 0 ? -count : count); |
2309
|
208
|
100
|
|
|
|
while (victim-- > namep + 1) |
2310
|
112
|
100
|
|
|
|
if ( |
2311
|
265
|
100
|
|
|
|
(HEK_UTF8(*victim) || (flags & SVf_UTF8)) |
|
|
50
|
|
|
|
|
|
|
100
|
|
|
|
|
2312
|
30
|
|
|
|
|
? hek_eq_pvn_flags(aTHX_ *victim, name, (I32)len, flags) |
2313
|
113
|
100
|
|
|
|
: (HEK_LEN(*victim) == (I32)len && memEQ(HEK_KEY(*victim), name, len)) |
2314
|
|
|
|
|
|
) { |
2315
|
72
|
|
|
|
|
unshare_hek_or_pvn(*victim, 0, 0, 0); |
2316
|
72
|
100
|
|
|
|
if (count < 0) ++aux->xhv_name_count; |
2317
|
24
|
|
|
|
|
else --aux->xhv_name_count; |
2318
|
72
|
100
|
|
|
|
if ( |
2319
|
72
|
|
|
|
|
(aux->xhv_name_count == 1 || aux->xhv_name_count == -1) |
2320
|
70
|
50
|
|
|
|
&& !*namep |
2321
|
|
|
|
|
|
) { /* if there are none left */ |
2322
|
0
|
|
|
|
|
Safefree(namep); |
2323
|
0
|
|
|
|
|
aux->xhv_name_u.xhvnameu_names = NULL; |
2324
|
0
|
|
|
|
|
aux->xhv_name_count = 0; |
2325
|
|
|
|
|
|
} |
2326
|
|
|
|
|
|
else { |
2327
|
|
|
|
|
|
/* Move the last one back to fill the empty slot. It |
2328
|
|
|
|
|
|
does not matter what order they are in. */ |
2329
|
72
|
100
|
|
|
|
*victim = *(namep + (count < 0 ? -count : count) - 1); |
2330
|
|
|
|
|
|
} |
2331
|
|
|
|
|
|
return; |
2332
|
|
|
|
|
|
} |
2333
|
40
|
50
|
|
|
|
if ( |
2334
|
93
|
50
|
|
|
|
count > 0 && (HEK_UTF8(*namep) || (flags & SVf_UTF8)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
2335
|
14
|
|
|
|
|
? hek_eq_pvn_flags(aTHX_ *namep, name, (I32)len, flags) |
2336
|
39
|
50
|
|
|
|
: (HEK_LEN(*namep) == (I32)len && memEQ(HEK_KEY(*namep), name, len)) |
2337
|
|
|
|
|
|
) { |
2338
|
40
|
|
|
|
|
aux->xhv_name_count = -count; |
2339
|
|
|
|
|
|
} |
2340
|
|
|
|
|
|
} |
2341
|
420
|
50
|
|
|
|
else if( |
2342
|
998
|
100
|
|
|
|
(HEK_UTF8(aux->xhv_name_u.xhvnameu_name) || (flags & SVf_UTF8)) |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
2343
|
104
|
|
|
|
|
? hek_eq_pvn_flags(aTHX_ aux->xhv_name_u.xhvnameu_name, name, (I32)len, flags) |
2344
|
474
|
50
|
|
|
|
: (HEK_LEN(aux->xhv_name_u.xhvnameu_name) == (I32)len && |
2345
|
316
|
|
|
|
|
memEQ(HEK_KEY(aux->xhv_name_u.xhvnameu_name), name, len)) |
2346
|
|
|
|
|
|
) { |
2347
|
420
|
|
|
|
|
HEK * const namehek = aux->xhv_name_u.xhvnameu_name; |
2348
|
420
|
|
|
|
|
Newx(aux->xhv_name_u.xhvnameu_names, 1, HEK *); |
2349
|
420
|
|
|
|
|
*aux->xhv_name_u.xhvnameu_names = namehek; |
2350
|
476
|
|
|
|
|
aux->xhv_name_count = -1; |
2351
|
|
|
|
|
|
} |
2352
|
|
|
|
|
|
} |
2353
|
|
|
|
|
|
|
2354
|
|
|
|
|
|
AV ** |
2355
|
127159123
|
|
|
|
|
Perl_hv_backreferences_p(pTHX_ HV *hv) { |
2356
|
127159123
|
100
|
|
|
|
struct xpvhv_aux * const iter = SvOOK(hv) ? HvAUX(hv) : hv_auxinit(hv); |
2357
|
|
|
|
|
|
|
2358
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_BACKREFERENCES_P; |
2359
|
|
|
|
|
|
PERL_UNUSED_CONTEXT; |
2360
|
|
|
|
|
|
|
2361
|
127159123
|
|
|
|
|
return &(iter->xhv_backreferences); |
2362
|
|
|
|
|
|
} |
2363
|
|
|
|
|
|
|
2364
|
|
|
|
|
|
void |
2365
|
114578395
|
|
|
|
|
Perl_hv_kill_backrefs(pTHX_ HV *hv) { |
2366
|
|
|
|
|
|
AV *av; |
2367
|
|
|
|
|
|
|
2368
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_KILL_BACKREFS; |
2369
|
|
|
|
|
|
|
2370
|
114578395
|
100
|
|
|
|
if (!SvOOK(hv)) |
2371
|
114578395
|
|
|
|
|
return; |
2372
|
|
|
|
|
|
|
2373
|
16964155
|
|
|
|
|
av = HvAUX(hv)->xhv_backreferences; |
2374
|
|
|
|
|
|
|
2375
|
16964155
|
100
|
|
|
|
if (av) { |
2376
|
674
|
|
|
|
|
HvAUX(hv)->xhv_backreferences = 0; |
2377
|
674
|
|
|
|
|
Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av); |
2378
|
674
|
100
|
|
|
|
if (SvTYPE(av) == SVt_PVAV) |
2379
|
508
|
|
|
|
|
SvREFCNT_dec_NN(av); |
2380
|
|
|
|
|
|
} |
2381
|
|
|
|
|
|
} |
2382
|
|
|
|
|
|
|
2383
|
|
|
|
|
|
/* |
2384
|
|
|
|
|
|
hv_iternext is implemented as a macro in hv.h |
2385
|
|
|
|
|
|
|
2386
|
|
|
|
|
|
=for apidoc hv_iternext |
2387
|
|
|
|
|
|
|
2388
|
|
|
|
|
|
Returns entries from a hash iterator. See C. |
2389
|
|
|
|
|
|
|
2390
|
|
|
|
|
|
You may call C or C on the hash entry that the |
2391
|
|
|
|
|
|
iterator currently points to, without losing your place or invalidating your |
2392
|
|
|
|
|
|
iterator. Note that in this case the current entry is deleted from the hash |
2393
|
|
|
|
|
|
with your iterator holding the last reference to it. Your iterator is flagged |
2394
|
|
|
|
|
|
to free the entry on the next call to C, so you must not discard |
2395
|
|
|
|
|
|
your iterator immediately else the entry will leak - call C to |
2396
|
|
|
|
|
|
trigger the resource deallocation. |
2397
|
|
|
|
|
|
|
2398
|
|
|
|
|
|
=for apidoc hv_iternext_flags |
2399
|
|
|
|
|
|
|
2400
|
|
|
|
|
|
Returns entries from a hash iterator. See C and C. |
2401
|
|
|
|
|
|
The C value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is |
2402
|
|
|
|
|
|
set the placeholders keys (for restricted hashes) will be returned in addition |
2403
|
|
|
|
|
|
to normal keys. By default placeholders are automatically skipped over. |
2404
|
|
|
|
|
|
Currently a placeholder is implemented with a value that is |
2405
|
|
|
|
|
|
C<&PL_sv_placeholder>. Note that the implementation of placeholders and |
2406
|
|
|
|
|
|
restricted hashes may change, and the implementation currently is |
2407
|
|
|
|
|
|
insufficiently abstracted for any change to be tidy. |
2408
|
|
|
|
|
|
|
2409
|
|
|
|
|
|
=cut |
2410
|
|
|
|
|
|
*/ |
2411
|
|
|
|
|
|
|
2412
|
|
|
|
|
|
HE * |
2413
|
167645009
|
|
|
|
|
Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags) |
2414
|
|
|
|
|
|
{ |
2415
|
|
|
|
|
|
dVAR; |
2416
|
|
|
|
|
|
XPVHV* xhv; |
2417
|
|
|
|
|
|
HE *entry; |
2418
|
|
|
|
|
|
HE *oldentry; |
2419
|
|
|
|
|
|
MAGIC* mg; |
2420
|
|
|
|
|
|
struct xpvhv_aux *iter; |
2421
|
|
|
|
|
|
|
2422
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ITERNEXT_FLAGS; |
2423
|
|
|
|
|
|
|
2424
|
167645009
|
50
|
|
|
|
if (!hv) |
2425
|
0
|
|
|
|
|
Perl_croak(aTHX_ "Bad hash"); |
2426
|
|
|
|
|
|
|
2427
|
167645009
|
|
|
|
|
xhv = (XPVHV*)SvANY(hv); |
2428
|
|
|
|
|
|
|
2429
|
167645009
|
100
|
|
|
|
if (!SvOOK(hv)) { |
2430
|
|
|
|
|
|
/* Too many things (well, pp_each at least) merrily assume that you can |
2431
|
|
|
|
|
|
call hv_iternext without calling hv_iterinit, so we'll have to deal |
2432
|
|
|
|
|
|
with it. */ |
2433
|
19148
|
|
|
|
|
hv_iterinit(hv); |
2434
|
|
|
|
|
|
} |
2435
|
167645009
|
|
|
|
|
iter = HvAUX(hv); |
2436
|
|
|
|
|
|
|
2437
|
167645009
|
|
|
|
|
oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ |
2438
|
167645009
|
100
|
|
|
|
if (SvMAGICAL(hv) && SvRMAGICAL(hv)) { |
|
|
100
|
|
|
|
|
2439
|
14321652
|
100
|
|
|
|
if ( ( mg = mg_find((const SV *)hv, PERL_MAGIC_tied) ) ) { |
2440
|
2021198
|
|
|
|
|
SV * const key = sv_newmortal(); |
2441
|
2021198
|
100
|
|
|
|
if (entry) { |
2442
|
2017962
|
50
|
|
|
|
sv_setsv(key, HeSVKEY_force(entry)); |
|
|
50
|
|
|
|
|
2443
|
2017962
|
50
|
|
|
|
SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */ |
|
|
50
|
|
|
|
|
2444
|
2017962
|
|
|
|
|
HeSVKEY_set(entry, NULL); |
2445
|
|
|
|
|
|
} |
2446
|
|
|
|
|
|
else { |
2447
|
|
|
|
|
|
char *k; |
2448
|
|
|
|
|
|
HEK *hek; |
2449
|
|
|
|
|
|
|
2450
|
|
|
|
|
|
/* one HE per MAGICAL hash */ |
2451
|
3236
|
|
|
|
|
iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */ |
2452
|
3236
|
|
|
|
|
HvLAZYDEL_on(hv); /* make sure entry gets freed */ |
2453
|
|
|
|
|
|
Zero(entry, 1, HE); |
2454
|
3236
|
|
|
|
|
Newxz(k, HEK_BASESIZE + sizeof(const SV *), char); |
2455
|
|
|
|
|
|
hek = (HEK*)k; |
2456
|
3236
|
|
|
|
|
HeKEY_hek(entry) = hek; |
2457
|
3236
|
|
|
|
|
HeKLEN(entry) = HEf_SVKEY; |
2458
|
|
|
|
|
|
} |
2459
|
2021198
|
|
|
|
|
magic_nextpack(MUTABLE_SV(hv),mg,key); |
2460
|
2021194
|
100
|
|
|
|
if (SvOK(key)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
2461
|
|
|
|
|
|
/* force key to stay around until next time */ |
2462
|
2017982
|
|
|
|
|
HeSVKEY_set(entry, SvREFCNT_inc_simple_NN(key)); |
2463
|
2017982
|
|
|
|
|
return entry; /* beware, hent_val is not set */ |
2464
|
|
|
|
|
|
} |
2465
|
3212
|
|
|
|
|
SvREFCNT_dec(HeVAL(entry)); |
2466
|
3212
|
|
|
|
|
Safefree(HeKEY_hek(entry)); |
2467
|
3212
|
|
|
|
|
del_HE(entry); |
2468
|
3212
|
|
|
|
|
iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */ |
2469
|
3212
|
|
|
|
|
HvLAZYDEL_off(hv); |
2470
|
3212
|
|
|
|
|
return NULL; |
2471
|
|
|
|
|
|
} |
2472
|
|
|
|
|
|
} |
2473
|
|
|
|
|
|
#if defined(DYNAMIC_ENV_FETCH) && !defined(__riscos__) /* set up %ENV for iteration */ |
2474
|
|
|
|
|
|
if (!entry && SvRMAGICAL((const SV *)hv) |
2475
|
|
|
|
|
|
&& mg_find((const SV *)hv, PERL_MAGIC_env)) { |
2476
|
|
|
|
|
|
prime_env_iter(); |
2477
|
|
|
|
|
|
#ifdef VMS |
2478
|
|
|
|
|
|
/* The prime_env_iter() on VMS just loaded up new hash values |
2479
|
|
|
|
|
|
* so the iteration count needs to be reset back to the beginning |
2480
|
|
|
|
|
|
*/ |
2481
|
|
|
|
|
|
hv_iterinit(hv); |
2482
|
|
|
|
|
|
iter = HvAUX(hv); |
2483
|
|
|
|
|
|
oldentry = entry = iter->xhv_eiter; /* HvEITER(hv) */ |
2484
|
|
|
|
|
|
#endif |
2485
|
|
|
|
|
|
} |
2486
|
|
|
|
|
|
#endif |
2487
|
|
|
|
|
|
|
2488
|
|
|
|
|
|
/* hv_iterinit now ensures this. */ |
2489
|
|
|
|
|
|
assert (HvARRAY(hv)); |
2490
|
|
|
|
|
|
|
2491
|
|
|
|
|
|
/* At start of hash, entry is NULL. */ |
2492
|
165623811
|
100
|
|
|
|
if (entry) |
2493
|
|
|
|
|
|
{ |
2494
|
136541115
|
|
|
|
|
entry = HeNEXT(entry); |
2495
|
136541115
|
100
|
|
|
|
if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { |
2496
|
|
|
|
|
|
/* |
2497
|
|
|
|
|
|
* Skip past any placeholders -- don't want to include them in |
2498
|
|
|
|
|
|
* any iteration. |
2499
|
|
|
|
|
|
*/ |
2500
|
93646173
|
100
|
|
|
|
while (entry && HeVAL(entry) == &PL_sv_placeholder) { |
|
|
50
|
|
|
|
|
2501
|
0
|
|
|
|
|
entry = HeNEXT(entry); |
2502
|
|
|
|
|
|
} |
2503
|
|
|
|
|
|
} |
2504
|
|
|
|
|
|
} |
2505
|
|
|
|
|
|
|
2506
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
2507
|
165623811
|
100
|
|
|
|
if (iter->xhv_last_rand != iter->xhv_rand) { |
2508
|
4114
|
100
|
|
|
|
if (iter->xhv_riter != -1) { |
2509
|
34
|
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), |
2510
|
|
|
|
|
|
"Use of each() on hash after insertion without resetting hash iterator results in undefined behavior" |
2511
|
|
|
|
|
|
pTHX__FORMAT |
2512
|
|
|
|
|
|
pTHX__VALUE); |
2513
|
|
|
|
|
|
} |
2514
|
4114
|
|
|
|
|
iter->xhv_last_rand = iter->xhv_rand; |
2515
|
|
|
|
|
|
} |
2516
|
|
|
|
|
|
#endif |
2517
|
|
|
|
|
|
|
2518
|
|
|
|
|
|
/* Skip the entire loop if the hash is empty. */ |
2519
|
260486262
|
100
|
|
|
|
if ((flags & HV_ITERNEXT_WANTPLACEHOLDERS) |
|
|
100
|
|
|
|
|
|
|
100
|
|
|
|
|
2520
|
177434250
|
|
|
|
|
? HvTOTALKEYS(hv) : HvUSEDKEYS(hv)) { |
2521
|
442032410
|
100
|
|
|
|
while (!entry) { |
2522
|
|
|
|
|
|
/* OK. Come to the end of the current list. Grab the next one. */ |
2523
|
|
|
|
|
|
|
2524
|
290783190
|
|
|
|
|
iter->xhv_riter++; /* HvRITER(hv)++ */ |
2525
|
290783190
|
100
|
|
|
|
if (iter->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) { |
2526
|
|
|
|
|
|
/* There is no next one. End of the hash. */ |
2527
|
11306571
|
|
|
|
|
iter->xhv_riter = -1; /* HvRITER(hv) = -1 */ |
2528
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
2529
|
11306571
|
|
|
|
|
iter->xhv_last_rand = iter->xhv_rand; /* reset xhv_last_rand so we can detect inserts during traversal */ |
2530
|
|
|
|
|
|
#endif |
2531
|
11306571
|
|
|
|
|
break; |
2532
|
|
|
|
|
|
} |
2533
|
279476619
|
|
|
|
|
entry = (HvARRAY(hv))[ PERL_HASH_ITER_BUCKET(iter) & xhv->xhv_max ]; |
2534
|
|
|
|
|
|
|
2535
|
279476619
|
100
|
|
|
|
if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) { |
2536
|
|
|
|
|
|
/* If we have an entry, but it's a placeholder, don't count it. |
2537
|
|
|
|
|
|
Try the next. */ |
2538
|
227679764
|
100
|
|
|
|
while (entry && HeVAL(entry) == &PL_sv_placeholder) |
|
|
100
|
|
|
|
|
2539
|
54
|
|
|
|
|
entry = HeNEXT(entry); |
2540
|
|
|
|
|
|
} |
2541
|
|
|
|
|
|
/* Will loop again if this linked list starts NULL |
2542
|
|
|
|
|
|
(for HV_ITERNEXT_WANTPLACEHOLDERS) |
2543
|
|
|
|
|
|
or if we run through it and find only placeholders. */ |
2544
|
|
|
|
|
|
} |
2545
|
|
|
|
|
|
} |
2546
|
|
|
|
|
|
else { |
2547
|
3068020
|
|
|
|
|
iter->xhv_riter = -1; |
2548
|
|
|
|
|
|
#ifdef PERL_HASH_RANDOMIZE_KEYS |
2549
|
3068020
|
|
|
|
|
iter->xhv_last_rand = iter->xhv_rand; |
2550
|
|
|
|
|
|
#endif |
2551
|
|
|
|
|
|
} |
2552
|
|
|
|
|
|
|
2553
|
165623811
|
100
|
|
|
|
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */ |
|
|
100
|
|
|
|
|
2554
|
4
|
|
|
|
|
HvLAZYDEL_off(hv); |
2555
|
4
|
|
|
|
|
hv_free_ent(hv, oldentry); |
2556
|
|
|
|
|
|
} |
2557
|
|
|
|
|
|
|
2558
|
165623811
|
|
|
|
|
iter->xhv_eiter = entry; /* HvEITER(hv) = entry */ |
2559
|
166634408
|
|
|
|
|
return entry; |
2560
|
|
|
|
|
|
} |
2561
|
|
|
|
|
|
|
2562
|
|
|
|
|
|
/* |
2563
|
|
|
|
|
|
=for apidoc hv_iterkey |
2564
|
|
|
|
|
|
|
2565
|
|
|
|
|
|
Returns the key from the current position of the hash iterator. See |
2566
|
|
|
|
|
|
C. |
2567
|
|
|
|
|
|
|
2568
|
|
|
|
|
|
=cut |
2569
|
|
|
|
|
|
*/ |
2570
|
|
|
|
|
|
|
2571
|
|
|
|
|
|
char * |
2572
|
867338
|
|
|
|
|
Perl_hv_iterkey(pTHX_ HE *entry, I32 *retlen) |
2573
|
|
|
|
|
|
{ |
2574
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ITERKEY; |
2575
|
|
|
|
|
|
|
2576
|
867338
|
50
|
|
|
|
if (HeKLEN(entry) == HEf_SVKEY) { |
2577
|
|
|
|
|
|
STRLEN len; |
2578
|
0
|
0
|
|
|
|
char * const p = SvPV(HeKEY_sv(entry), len); |
2579
|
0
|
|
|
|
|
*retlen = len; |
2580
|
0
|
|
|
|
|
return p; |
2581
|
|
|
|
|
|
} |
2582
|
|
|
|
|
|
else { |
2583
|
867338
|
|
|
|
|
*retlen = HeKLEN(entry); |
2584
|
867338
|
|
|
|
|
return HeKEY(entry); |
2585
|
|
|
|
|
|
} |
2586
|
|
|
|
|
|
} |
2587
|
|
|
|
|
|
|
2588
|
|
|
|
|
|
/* unlike hv_iterval(), this always returns a mortal copy of the key */ |
2589
|
|
|
|
|
|
/* |
2590
|
|
|
|
|
|
=for apidoc hv_iterkeysv |
2591
|
|
|
|
|
|
|
2592
|
|
|
|
|
|
Returns the key as an C from the current position of the hash |
2593
|
|
|
|
|
|
iterator. The return value will always be a mortal copy of the key. Also |
2594
|
|
|
|
|
|
see C. |
2595
|
|
|
|
|
|
|
2596
|
|
|
|
|
|
=cut |
2597
|
|
|
|
|
|
*/ |
2598
|
|
|
|
|
|
|
2599
|
|
|
|
|
|
SV * |
2600
|
84786295
|
|
|
|
|
Perl_hv_iterkeysv(pTHX_ HE *entry) |
2601
|
|
|
|
|
|
{ |
2602
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ITERKEYSV; |
2603
|
|
|
|
|
|
|
2604
|
84786295
|
|
|
|
|
return sv_2mortal(newSVhek(HeKEY_hek(entry))); |
2605
|
|
|
|
|
|
} |
2606
|
|
|
|
|
|
|
2607
|
|
|
|
|
|
/* |
2608
|
|
|
|
|
|
=for apidoc hv_iterval |
2609
|
|
|
|
|
|
|
2610
|
|
|
|
|
|
Returns the value from the current position of the hash iterator. See |
2611
|
|
|
|
|
|
C. |
2612
|
|
|
|
|
|
|
2613
|
|
|
|
|
|
=cut |
2614
|
|
|
|
|
|
*/ |
2615
|
|
|
|
|
|
|
2616
|
|
|
|
|
|
SV * |
2617
|
74213257
|
|
|
|
|
Perl_hv_iterval(pTHX_ HV *hv, HE *entry) |
2618
|
|
|
|
|
|
{ |
2619
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ITERVAL; |
2620
|
|
|
|
|
|
|
2621
|
74213257
|
100
|
|
|
|
if (SvRMAGICAL(hv)) { |
2622
|
9643056
|
100
|
|
|
|
if (mg_find((const SV *)hv, PERL_MAGIC_tied)) { |
2623
|
1913406
|
|
|
|
|
SV* const sv = sv_newmortal(); |
2624
|
1913406
|
50
|
|
|
|
if (HeKLEN(entry) == HEf_SVKEY) |
2625
|
1913406
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), sv, (char*)HeKEY_sv(entry), HEf_SVKEY); |
2626
|
|
|
|
|
|
else |
2627
|
0
|
|
|
|
|
mg_copy(MUTABLE_SV(hv), sv, HeKEY(entry), HeKLEN(entry)); |
2628
|
|
|
|
|
|
return sv; |
2629
|
|
|
|
|
|
} |
2630
|
|
|
|
|
|
} |
2631
|
73256554
|
|
|
|
|
return HeVAL(entry); |
2632
|
|
|
|
|
|
} |
2633
|
|
|
|
|
|
|
2634
|
|
|
|
|
|
/* |
2635
|
|
|
|
|
|
=for apidoc hv_iternextsv |
2636
|
|
|
|
|
|
|
2637
|
|
|
|
|
|
Performs an C, C, and C in one |
2638
|
|
|
|
|
|
operation. |
2639
|
|
|
|
|
|
|
2640
|
|
|
|
|
|
=cut |
2641
|
|
|
|
|
|
*/ |
2642
|
|
|
|
|
|
|
2643
|
|
|
|
|
|
SV * |
2644
|
6534
|
|
|
|
|
Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen) |
2645
|
|
|
|
|
|
{ |
2646
|
6534
|
|
|
|
|
HE * const he = hv_iternext_flags(hv, 0); |
2647
|
|
|
|
|
|
|
2648
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ITERNEXTSV; |
2649
|
|
|
|
|
|
|
2650
|
6534
|
100
|
|
|
|
if (!he) |
2651
|
|
|
|
|
|
return NULL; |
2652
|
6014
|
|
|
|
|
*key = hv_iterkey(he, retlen); |
2653
|
6274
|
|
|
|
|
return hv_iterval(hv, he); |
2654
|
|
|
|
|
|
} |
2655
|
|
|
|
|
|
|
2656
|
|
|
|
|
|
/* |
2657
|
|
|
|
|
|
|
2658
|
|
|
|
|
|
Now a macro in hv.h |
2659
|
|
|
|
|
|
|
2660
|
|
|
|
|
|
=for apidoc hv_magic |
2661
|
|
|
|
|
|
|
2662
|
|
|
|
|
|
Adds magic to a hash. See C. |
2663
|
|
|
|
|
|
|
2664
|
|
|
|
|
|
=cut |
2665
|
|
|
|
|
|
*/ |
2666
|
|
|
|
|
|
|
2667
|
|
|
|
|
|
/* possibly free a shared string if no one has access to it |
2668
|
|
|
|
|
|
* len and hash must both be valid for str. |
2669
|
|
|
|
|
|
*/ |
2670
|
|
|
|
|
|
void |
2671
|
0
|
|
|
|
|
Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash) |
2672
|
|
|
|
|
|
{ |
2673
|
0
|
|
|
|
|
unshare_hek_or_pvn (NULL, str, len, hash); |
2674
|
0
|
|
|
|
|
} |
2675
|
|
|
|
|
|
|
2676
|
|
|
|
|
|
|
2677
|
|
|
|
|
|
void |
2678
|
992224976
|
|
|
|
|
Perl_unshare_hek(pTHX_ HEK *hek) |
2679
|
|
|
|
|
|
{ |
2680
|
|
|
|
|
|
assert(hek); |
2681
|
992224976
|
|
|
|
|
unshare_hek_or_pvn(hek, NULL, 0, 0); |
2682
|
992224976
|
|
|
|
|
} |
2683
|
|
|
|
|
|
|
2684
|
|
|
|
|
|
/* possibly free a shared string if no one has access to it |
2685
|
|
|
|
|
|
hek if non-NULL takes priority over the other 3, else str, len and hash |
2686
|
|
|
|
|
|
are used. If so, len and hash must both be valid for str. |
2687
|
|
|
|
|
|
*/ |
2688
|
|
|
|
|
|
STATIC void |
2689
|
992238132
|
|
|
|
|
S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) |
2690
|
|
|
|
|
|
{ |
2691
|
|
|
|
|
|
dVAR; |
2692
|
|
|
|
|
|
XPVHV* xhv; |
2693
|
|
|
|
|
|
HE *entry; |
2694
|
|
|
|
|
|
HE **oentry; |
2695
|
992238132
|
|
|
|
|
bool is_utf8 = FALSE; |
2696
|
|
|
|
|
|
int k_flags = 0; |
2697
|
|
|
|
|
|
const char * const save = str; |
2698
|
|
|
|
|
|
struct shared_he *he = NULL; |
2699
|
|
|
|
|
|
|
2700
|
992238132
|
50
|
|
|
|
if (hek) { |
2701
|
|
|
|
|
|
/* Find the shared he which is just before us in memory. */ |
2702
|
992238132
|
|
|
|
|
he = (struct shared_he *)(((char *)hek) |
2703
|
|
|
|
|
|
- STRUCT_OFFSET(struct shared_he, |
2704
|
|
|
|
|
|
shared_he_hek)); |
2705
|
|
|
|
|
|
|
2706
|
|
|
|
|
|
/* Assert that the caller passed us a genuine (or at least consistent) |
2707
|
|
|
|
|
|
shared hek */ |
2708
|
|
|
|
|
|
assert (he->shared_he_he.hent_hek == hek); |
2709
|
|
|
|
|
|
|
2710
|
992238132
|
100
|
|
|
|
if (he->shared_he_he.he_valu.hent_refcount - 1) { |
2711
|
938911576
|
|
|
|
|
--he->shared_he_he.he_valu.hent_refcount; |
2712
|
1460891942
|
|
|
|
|
return; |
2713
|
|
|
|
|
|
} |
2714
|
|
|
|
|
|
|
2715
|
53326556
|
|
|
|
|
hash = HEK_HASH(hek); |
2716
|
0
|
0
|
|
|
|
} else if (len < 0) { |
2717
|
0
|
|
|
|
|
STRLEN tmplen = -len; |
2718
|
0
|
|
|
|
|
is_utf8 = TRUE; |
2719
|
|
|
|
|
|
/* See the note in hv_fetch(). --jhi */ |
2720
|
0
|
|
|
|
|
str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8); |
2721
|
0
|
|
|
|
|
len = tmplen; |
2722
|
0
|
0
|
|
|
|
if (is_utf8) |
2723
|
|
|
|
|
|
k_flags = HVhek_UTF8; |
2724
|
0
|
0
|
|
|
|
if (str != save) |
2725
|
0
|
|
|
|
|
k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY; |
2726
|
|
|
|
|
|
} |
2727
|
|
|
|
|
|
|
2728
|
|
|
|
|
|
/* what follows was the moral equivalent of: |
2729
|
|
|
|
|
|
if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) { |
2730
|
|
|
|
|
|
if (--*Svp == NULL) |
2731
|
|
|
|
|
|
hv_delete(PL_strtab, str, len, G_DISCARD, hash); |
2732
|
|
|
|
|
|
} */ |
2733
|
53326556
|
|
|
|
|
xhv = (XPVHV*)SvANY(PL_strtab); |
2734
|
|
|
|
|
|
/* assert(xhv_array != 0) */ |
2735
|
53326556
|
|
|
|
|
oentry = &(HvARRAY(PL_strtab))[hash & (I32) HvMAX(PL_strtab)]; |
2736
|
53326556
|
50
|
|
|
|
if (he) { |
2737
|
53326556
|
|
|
|
|
const HE *const he_he = &(he->shared_he_he); |
2738
|
57494397
|
50
|
|
|
|
for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) { |
2739
|
57494397
|
100
|
|
|
|
if (entry == he_he) |
2740
|
|
|
|
|
|
break; |
2741
|
|
|
|
|
|
} |
2742
|
|
|
|
|
|
} else { |
2743
|
0
|
|
|
|
|
const int flags_masked = k_flags & HVhek_MASK; |
2744
|
0
|
0
|
|
|
|
for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) { |
2745
|
0
|
0
|
|
|
|
if (HeHASH(entry) != hash) /* strings can't be equal */ |
2746
|
0
|
|
|
|
|
continue; |
2747
|
0
|
0
|
|
|
|
if (HeKLEN(entry) != len) |
2748
|
0
|
|
|
|
|
continue; |
2749
|
0
|
0
|
|
|
|
if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ |
|
|
0
|
|
|
|
|
2750
|
0
|
|
|
|
|
continue; |
2751
|
0
|
0
|
|
|
|
if (HeKFLAGS(entry) != flags_masked) |
2752
|
0
|
|
|
|
|
continue; |
2753
|
|
|
|
|
|
break; |
2754
|
|
|
|
|
|
} |
2755
|
|
|
|
|
|
} |
2756
|
|
|
|
|
|
|
2757
|
53326556
|
50
|
|
|
|
if (entry) { |
2758
|
53326556
|
50
|
|
|
|
if (--entry->he_valu.hent_refcount == 0) { |
2759
|
53326556
|
|
|
|
|
*oentry = HeNEXT(entry); |
2760
|
53326556
|
|
|
|
|
Safefree(entry); |
2761
|
53326556
|
|
|
|
|
xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */ |
2762
|
|
|
|
|
|
} |
2763
|
|
|
|
|
|
} |
2764
|
|
|
|
|
|
|
2765
|
53326556
|
50
|
|
|
|
if (!entry) |
2766
|
0
|
0
|
|
|
|
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), |
|
|
0
|
|
|
|
|
2767
|
|
|
|
|
|
"Attempt to free nonexistent shared string '%s'%s" |
2768
|
|
|
|
|
|
pTHX__FORMAT, |
2769
|
|
|
|
|
|
hek ? HEK_KEY(hek) : str, |
2770
|
0
|
|
|
|
|
((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); |
2771
|
53326556
|
50
|
|
|
|
if (k_flags & HVhek_FREEKEY) |
2772
|
0
|
|
|
|
|
Safefree(str); |
2773
|
|
|
|
|
|
} |
2774
|
|
|
|
|
|
|
2775
|
|
|
|
|
|
/* get a (constant) string ptr from the global string table |
2776
|
|
|
|
|
|
* string will get added if it is not already there. |
2777
|
|
|
|
|
|
* len and hash must both be valid for str. |
2778
|
|
|
|
|
|
*/ |
2779
|
|
|
|
|
|
HEK * |
2780
|
135095081
|
|
|
|
|
Perl_share_hek(pTHX_ const char *str, I32 len, U32 hash) |
2781
|
|
|
|
|
|
{ |
2782
|
135095081
|
|
|
|
|
bool is_utf8 = FALSE; |
2783
|
|
|
|
|
|
int flags = 0; |
2784
|
|
|
|
|
|
const char * const save = str; |
2785
|
|
|
|
|
|
|
2786
|
|
|
|
|
|
PERL_ARGS_ASSERT_SHARE_HEK; |
2787
|
|
|
|
|
|
|
2788
|
135095081
|
100
|
|
|
|
if (len < 0) { |
2789
|
8870
|
|
|
|
|
STRLEN tmplen = -len; |
2790
|
8870
|
|
|
|
|
is_utf8 = TRUE; |
2791
|
|
|
|
|
|
/* See the note in hv_fetch(). --jhi */ |
2792
|
8870
|
|
|
|
|
str = (char*)bytes_from_utf8((U8*)str, &tmplen, &is_utf8); |
2793
|
8870
|
|
|
|
|
len = tmplen; |
2794
|
|
|
|
|
|
/* If we were able to downgrade here, then than means that we were passed |
2795
|
|
|
|
|
|
in a key which only had chars 0-255, but was utf8 encoded. */ |
2796
|
8870
|
100
|
|
|
|
if (is_utf8) |
2797
|
|
|
|
|
|
flags = HVhek_UTF8; |
2798
|
|
|
|
|
|
/* If we found we were able to downgrade the string to bytes, then |
2799
|
|
|
|
|
|
we should flag that it needs upgrading on keys or each. Also flag |
2800
|
|
|
|
|
|
that we need share_hek_flags to free the string. */ |
2801
|
8870
|
100
|
|
|
|
if (str != save) { |
2802
|
|
|
|
|
|
dVAR; |
2803
|
2134
|
|
|
|
|
PERL_HASH(hash, str, len); |
2804
|
2134
|
|
|
|
|
flags |= HVhek_WASUTF8 | HVhek_FREEKEY; |
2805
|
|
|
|
|
|
} |
2806
|
|
|
|
|
|
} |
2807
|
|
|
|
|
|
|
2808
|
135095081
|
|
|
|
|
return share_hek_flags (str, len, hash, flags); |
2809
|
|
|
|
|
|
} |
2810
|
|
|
|
|
|
|
2811
|
|
|
|
|
|
STATIC HEK * |
2812
|
644778342
|
|
|
|
|
S_share_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags) |
2813
|
|
|
|
|
|
{ |
2814
|
|
|
|
|
|
dVAR; |
2815
|
|
|
|
|
|
HE *entry; |
2816
|
644778342
|
|
|
|
|
const int flags_masked = flags & HVhek_MASK; |
2817
|
644778342
|
|
|
|
|
const U32 hindex = hash & (I32) HvMAX(PL_strtab); |
2818
|
644778342
|
|
|
|
|
XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab); |
2819
|
|
|
|
|
|
|
2820
|
|
|
|
|
|
PERL_ARGS_ASSERT_SHARE_HEK_FLAGS; |
2821
|
|
|
|
|
|
|
2822
|
|
|
|
|
|
/* what follows is the moral equivalent of: |
2823
|
|
|
|
|
|
|
2824
|
|
|
|
|
|
if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE))) |
2825
|
|
|
|
|
|
hv_store(PL_strtab, str, len, NULL, hash); |
2826
|
|
|
|
|
|
|
2827
|
|
|
|
|
|
Can't rehash the shared string table, so not sure if it's worth |
2828
|
|
|
|
|
|
counting the number of entries in the linked list |
2829
|
|
|
|
|
|
*/ |
2830
|
|
|
|
|
|
|
2831
|
|
|
|
|
|
/* assert(xhv_array != 0) */ |
2832
|
644778342
|
|
|
|
|
entry = (HvARRAY(PL_strtab))[hindex]; |
2833
|
971367863
|
100
|
|
|
|
for (;entry; entry = HeNEXT(entry)) { |
2834
|
868039212
|
100
|
|
|
|
if (HeHASH(entry) != hash) /* strings can't be equal */ |
2835
|
318716680
|
|
|
|
|
continue; |
2836
|
549322532
|
100
|
|
|
|
if (HeKLEN(entry) != len) |
2837
|
2131
|
|
|
|
|
continue; |
2838
|
549320401
|
100
|
|
|
|
if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ |
|
|
100
|
|
|
|
|
2839
|
1160
|
|
|
|
|
continue; |
2840
|
549319241
|
100
|
|
|
|
if (HeKFLAGS(entry) != flags_masked) |
2841
|
7869550
|
|
|
|
|
continue; |
2842
|
|
|
|
|
|
break; |
2843
|
|
|
|
|
|
} |
2844
|
|
|
|
|
|
|
2845
|
644778342
|
100
|
|
|
|
if (!entry) { |
2846
|
|
|
|
|
|
/* What used to be head of the list. |
2847
|
|
|
|
|
|
If this is NULL, then we're the first entry for this slot, which |
2848
|
|
|
|
|
|
means we need to increate fill. */ |
2849
|
|
|
|
|
|
struct shared_he *new_entry; |
2850
|
|
|
|
|
|
HEK *hek; |
2851
|
|
|
|
|
|
char *k; |
2852
|
103328651
|
|
|
|
|
HE **const head = &HvARRAY(PL_strtab)[hindex]; |
2853
|
103328651
|
|
|
|
|
HE *const next = *head; |
2854
|
|
|
|
|
|
|
2855
|
|
|
|
|
|
/* We don't actually store a HE from the arena and a regular HEK. |
2856
|
|
|
|
|
|
Instead we allocate one chunk of memory big enough for both, |
2857
|
|
|
|
|
|
and put the HEK straight after the HE. This way we can find the |
2858
|
|
|
|
|
|
HE directly from the HEK. |
2859
|
|
|
|
|
|
*/ |
2860
|
|
|
|
|
|
|
2861
|
103328651
|
|
|
|
|
Newx(k, STRUCT_OFFSET(struct shared_he, |
2862
|
|
|
|
|
|
shared_he_hek.hek_key[0]) + len + 2, char); |
2863
|
|
|
|
|
|
new_entry = (struct shared_he *)k; |
2864
|
103328651
|
|
|
|
|
entry = &(new_entry->shared_he_he); |
2865
|
103328651
|
|
|
|
|
hek = &(new_entry->shared_he_hek); |
2866
|
|
|
|
|
|
|
2867
|
103328651
|
|
|
|
|
Copy(str, HEK_KEY(hek), len, char); |
2868
|
103328651
|
|
|
|
|
HEK_KEY(hek)[len] = 0; |
2869
|
103328651
|
|
|
|
|
HEK_LEN(hek) = len; |
2870
|
103328651
|
|
|
|
|
HEK_HASH(hek) = hash; |
2871
|
103328651
|
|
|
|
|
HEK_FLAGS(hek) = (unsigned char)flags_masked; |
2872
|
|
|
|
|
|
|
2873
|
|
|
|
|
|
/* Still "point" to the HEK, so that other code need not know what |
2874
|
|
|
|
|
|
we're up to. */ |
2875
|
103328651
|
|
|
|
|
HeKEY_hek(entry) = hek; |
2876
|
103328651
|
|
|
|
|
entry->he_valu.hent_refcount = 0; |
2877
|
103328651
|
|
|
|
|
HeNEXT(entry) = next; |
2878
|
103328651
|
|
|
|
|
*head = entry; |
2879
|
|
|
|
|
|
|
2880
|
103328651
|
|
|
|
|
xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ |
2881
|
103328651
|
100
|
|
|
|
if (!next) { /* initial entry? */ |
2882
|
50724316
|
100
|
|
|
|
} else if ( DO_HSPLIT(xhv) ) { |
2883
|
39124
|
|
|
|
|
const STRLEN oldsize = xhv->xhv_max + 1; |
2884
|
39124
|
|
|
|
|
hsplit(PL_strtab, oldsize, oldsize * 2); |
2885
|
|
|
|
|
|
} |
2886
|
|
|
|
|
|
} |
2887
|
|
|
|
|
|
|
2888
|
644778342
|
|
|
|
|
++entry->he_valu.hent_refcount; |
2889
|
|
|
|
|
|
|
2890
|
644778342
|
100
|
|
|
|
if (flags & HVhek_FREEKEY) |
2891
|
8038
|
|
|
|
|
Safefree(str); |
2892
|
|
|
|
|
|
|
2893
|
644778342
|
|
|
|
|
return HeKEY_hek(entry); |
2894
|
|
|
|
|
|
} |
2895
|
|
|
|
|
|
|
2896
|
|
|
|
|
|
SSize_t * |
2897
|
30808
|
|
|
|
|
Perl_hv_placeholders_p(pTHX_ HV *hv) |
2898
|
|
|
|
|
|
{ |
2899
|
|
|
|
|
|
dVAR; |
2900
|
30808
|
|
|
|
|
MAGIC *mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); |
2901
|
|
|
|
|
|
|
2902
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_PLACEHOLDERS_P; |
2903
|
|
|
|
|
|
|
2904
|
30808
|
100
|
|
|
|
if (!mg) { |
2905
|
450
|
|
|
|
|
mg = sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, 0); |
2906
|
|
|
|
|
|
|
2907
|
450
|
50
|
|
|
|
if (!mg) { |
2908
|
0
|
|
|
|
|
Perl_die(aTHX_ "panic: hv_placeholders_p"); |
2909
|
|
|
|
|
|
} |
2910
|
|
|
|
|
|
} |
2911
|
30808
|
|
|
|
|
return &(mg->mg_len); |
2912
|
|
|
|
|
|
} |
2913
|
|
|
|
|
|
|
2914
|
|
|
|
|
|
|
2915
|
|
|
|
|
|
I32 |
2916
|
12624945
|
|
|
|
|
Perl_hv_placeholders_get(pTHX_ const HV *hv) |
2917
|
|
|
|
|
|
{ |
2918
|
|
|
|
|
|
dVAR; |
2919
|
12624945
|
|
|
|
|
MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); |
2920
|
|
|
|
|
|
|
2921
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_PLACEHOLDERS_GET; |
2922
|
|
|
|
|
|
|
2923
|
12624945
|
100
|
|
|
|
return mg ? mg->mg_len : 0; |
2924
|
|
|
|
|
|
} |
2925
|
|
|
|
|
|
|
2926
|
|
|
|
|
|
void |
2927
|
19835608
|
|
|
|
|
Perl_hv_placeholders_set(pTHX_ HV *hv, I32 ph) |
2928
|
|
|
|
|
|
{ |
2929
|
|
|
|
|
|
dVAR; |
2930
|
19835608
|
|
|
|
|
MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_rhash); |
2931
|
|
|
|
|
|
|
2932
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_PLACEHOLDERS_SET; |
2933
|
|
|
|
|
|
|
2934
|
19835608
|
50
|
|
|
|
if (mg) { |
2935
|
0
|
|
|
|
|
mg->mg_len = ph; |
2936
|
19835608
|
50
|
|
|
|
} else if (ph) { |
2937
|
0
|
0
|
|
|
|
if (!sv_magicext(MUTABLE_SV(hv), 0, PERL_MAGIC_rhash, 0, 0, ph)) |
2938
|
0
|
|
|
|
|
Perl_die(aTHX_ "panic: hv_placeholders_set"); |
2939
|
|
|
|
|
|
} |
2940
|
|
|
|
|
|
/* else we don't need to add magic to record 0 placeholders. */ |
2941
|
19835608
|
|
|
|
|
} |
2942
|
|
|
|
|
|
|
2943
|
|
|
|
|
|
STATIC SV * |
2944
|
22255048
|
|
|
|
|
S_refcounted_he_value(pTHX_ const struct refcounted_he *he) |
2945
|
|
|
|
|
|
{ |
2946
|
|
|
|
|
|
dVAR; |
2947
|
|
|
|
|
|
SV *value; |
2948
|
|
|
|
|
|
|
2949
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_VALUE; |
2950
|
|
|
|
|
|
|
2951
|
22255048
|
|
|
|
|
switch(he->refcounted_he_data[0] & HVrhek_typemask) { |
2952
|
|
|
|
|
|
case HVrhek_undef: |
2953
|
284
|
|
|
|
|
value = newSV(0); |
2954
|
284
|
|
|
|
|
break; |
2955
|
|
|
|
|
|
case HVrhek_delete: |
2956
|
|
|
|
|
|
value = &PL_sv_placeholder; |
2957
|
|
|
|
|
|
break; |
2958
|
|
|
|
|
|
case HVrhek_IV: |
2959
|
1792864
|
|
|
|
|
value = newSViv(he->refcounted_he_val.refcounted_he_u_iv); |
2960
|
1792864
|
|
|
|
|
break; |
2961
|
|
|
|
|
|
case HVrhek_UV: |
2962
|
14
|
|
|
|
|
value = newSVuv(he->refcounted_he_val.refcounted_he_u_uv); |
2963
|
14
|
|
|
|
|
break; |
2964
|
|
|
|
|
|
case HVrhek_PV: |
2965
|
|
|
|
|
|
case HVrhek_PV_UTF8: |
2966
|
|
|
|
|
|
/* Create a string SV that directly points to the bytes in our |
2967
|
|
|
|
|
|
structure. */ |
2968
|
3800894
|
|
|
|
|
value = newSV_type(SVt_PV); |
2969
|
3800894
|
|
|
|
|
SvPV_set(value, (char *) he->refcounted_he_data + 1); |
2970
|
3800894
|
|
|
|
|
SvCUR_set(value, he->refcounted_he_val.refcounted_he_u_len); |
2971
|
|
|
|
|
|
/* This stops anything trying to free it */ |
2972
|
3800894
|
|
|
|
|
SvLEN_set(value, 0); |
2973
|
3800894
|
|
|
|
|
SvPOK_on(value); |
2974
|
3800894
|
|
|
|
|
SvREADONLY_on(value); |
2975
|
3800894
|
100
|
|
|
|
if ((he->refcounted_he_data[0] & HVrhek_typemask) == HVrhek_PV_UTF8) |
2976
|
618
|
|
|
|
|
SvUTF8_on(value); |
2977
|
|
|
|
|
|
break; |
2978
|
|
|
|
|
|
default: |
2979
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: refcounted_he_value bad flags %"UVxf, |
2980
|
0
|
|
|
|
|
(UV)he->refcounted_he_data[0]); |
2981
|
|
|
|
|
|
} |
2982
|
22255048
|
|
|
|
|
return value; |
2983
|
|
|
|
|
|
} |
2984
|
|
|
|
|
|
|
2985
|
|
|
|
|
|
/* |
2986
|
|
|
|
|
|
=for apidoc m|HV *|refcounted_he_chain_2hv|const struct refcounted_he *c|U32 flags |
2987
|
|
|
|
|
|
|
2988
|
|
|
|
|
|
Generates and returns a C representing the content of a |
2989
|
|
|
|
|
|
C chain. |
2990
|
|
|
|
|
|
I is currently unused and must be zero. |
2991
|
|
|
|
|
|
|
2992
|
|
|
|
|
|
=cut |
2993
|
|
|
|
|
|
*/ |
2994
|
|
|
|
|
|
HV * |
2995
|
1917860
|
|
|
|
|
Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain, U32 flags) |
2996
|
|
|
|
|
|
{ |
2997
|
|
|
|
|
|
dVAR; |
2998
|
|
|
|
|
|
HV *hv; |
2999
|
|
|
|
|
|
U32 placeholders, max; |
3000
|
|
|
|
|
|
|
3001
|
1917860
|
50
|
|
|
|
if (flags) |
3002
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: refcounted_he_chain_2hv bad flags %"UVxf, |
3003
|
|
|
|
|
|
(UV)flags); |
3004
|
|
|
|
|
|
|
3005
|
|
|
|
|
|
/* We could chase the chain once to get an idea of the number of keys, |
3006
|
|
|
|
|
|
and call ksplit. But for now we'll make a potentially inefficient |
3007
|
|
|
|
|
|
hash with only 8 entries in its array. */ |
3008
|
1917860
|
|
|
|
|
hv = newHV(); |
3009
|
1917860
|
|
|
|
|
max = HvMAX(hv); |
3010
|
1917860
|
50
|
|
|
|
if (!HvARRAY(hv)) { |
3011
|
|
|
|
|
|
char *array; |
3012
|
1917860
|
|
|
|
|
Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(max + 1), char); |
3013
|
1917860
|
|
|
|
|
HvARRAY(hv) = (HE**)array; |
3014
|
|
|
|
|
|
} |
3015
|
|
|
|
|
|
|
3016
|
|
|
|
|
|
placeholders = 0; |
3017
|
10012152
|
100
|
|
|
|
while (chain) { |
3018
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3019
|
|
|
|
|
|
U32 hash = chain->refcounted_he_hash; |
3020
|
|
|
|
|
|
#else |
3021
|
8094292
|
|
|
|
|
U32 hash = HEK_HASH(chain->refcounted_he_hek); |
3022
|
|
|
|
|
|
#endif |
3023
|
8094292
|
|
|
|
|
HE **oentry = &((HvARRAY(hv))[hash & max]); |
3024
|
8094292
|
|
|
|
|
HE *entry = *oentry; |
3025
|
|
|
|
|
|
SV *value; |
3026
|
|
|
|
|
|
|
3027
|
13148298
|
100
|
|
|
|
for (; entry; entry = HeNEXT(entry)) { |
3028
|
6283524
|
100
|
|
|
|
if (HeHASH(entry) == hash) { |
3029
|
|
|
|
|
|
/* We might have a duplicate key here. If so, entry is older |
3030
|
|
|
|
|
|
than the key we've already put in the hash, so if they are |
3031
|
|
|
|
|
|
the same, skip adding entry. */ |
3032
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3033
|
|
|
|
|
|
const STRLEN klen = HeKLEN(entry); |
3034
|
|
|
|
|
|
const char *const key = HeKEY(entry); |
3035
|
|
|
|
|
|
if (klen == chain->refcounted_he_keylen |
3036
|
|
|
|
|
|
&& (!!HeKUTF8(entry) |
3037
|
|
|
|
|
|
== !!(chain->refcounted_he_data[0] & HVhek_UTF8)) |
3038
|
|
|
|
|
|
&& memEQ(key, REF_HE_KEY(chain), klen)) |
3039
|
|
|
|
|
|
goto next_please; |
3040
|
|
|
|
|
|
#else |
3041
|
1229558
|
100
|
|
|
|
if (HeKEY_hek(entry) == chain->refcounted_he_hek) |
3042
|
|
|
|
|
|
goto next_please; |
3043
|
369046
|
50
|
|
|
|
if (HeKLEN(entry) == HEK_LEN(chain->refcounted_he_hek) |
3044
|
369046
|
100
|
|
|
|
&& HeKUTF8(entry) == HEK_UTF8(chain->refcounted_he_hek) |
3045
|
369006
|
50
|
|
|
|
&& memEQ(HeKEY(entry), HEK_KEY(chain->refcounted_he_hek), |
3046
|
|
|
|
|
|
HeKLEN(entry))) |
3047
|
|
|
|
|
|
goto next_please; |
3048
|
|
|
|
|
|
#endif |
3049
|
|
|
|
|
|
} |
3050
|
|
|
|
|
|
} |
3051
|
|
|
|
|
|
assert (!entry); |
3052
|
6864774
|
|
|
|
|
entry = new_HE(); |
3053
|
|
|
|
|
|
|
3054
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3055
|
|
|
|
|
|
HeKEY_hek(entry) |
3056
|
|
|
|
|
|
= share_hek_flags(REF_HE_KEY(chain), |
3057
|
|
|
|
|
|
chain->refcounted_he_keylen, |
3058
|
|
|
|
|
|
chain->refcounted_he_hash, |
3059
|
|
|
|
|
|
(chain->refcounted_he_data[0] |
3060
|
|
|
|
|
|
& (HVhek_UTF8|HVhek_WASUTF8))); |
3061
|
|
|
|
|
|
#else |
3062
|
6864774
|
|
|
|
|
HeKEY_hek(entry) = share_hek_hek(chain->refcounted_he_hek); |
3063
|
|
|
|
|
|
#endif |
3064
|
6864774
|
|
|
|
|
value = refcounted_he_value(chain); |
3065
|
6864774
|
100
|
|
|
|
if (value == &PL_sv_placeholder) |
3066
|
1382950
|
|
|
|
|
placeholders++; |
3067
|
6864774
|
|
|
|
|
HeVAL(entry) = value; |
3068
|
|
|
|
|
|
|
3069
|
|
|
|
|
|
/* Link it into the chain. */ |
3070
|
6864774
|
|
|
|
|
HeNEXT(entry) = *oentry; |
3071
|
6864774
|
|
|
|
|
*oentry = entry; |
3072
|
|
|
|
|
|
|
3073
|
6864774
|
|
|
|
|
HvTOTALKEYS(hv)++; |
3074
|
|
|
|
|
|
|
3075
|
|
|
|
|
|
next_please: |
3076
|
8094292
|
|
|
|
|
chain = chain->refcounted_he_next; |
3077
|
|
|
|
|
|
} |
3078
|
|
|
|
|
|
|
3079
|
1917860
|
100
|
|
|
|
if (placeholders) { |
3080
|
173942
|
|
|
|
|
clear_placeholders(hv, placeholders); |
3081
|
173942
|
|
|
|
|
HvTOTALKEYS(hv) -= placeholders; |
3082
|
|
|
|
|
|
} |
3083
|
|
|
|
|
|
|
3084
|
|
|
|
|
|
/* We could check in the loop to see if we encounter any keys with key |
3085
|
|
|
|
|
|
flags, but it's probably not worth it, as this per-hash flag is only |
3086
|
|
|
|
|
|
really meant as an optimisation for things like Storable. */ |
3087
|
1917860
|
|
|
|
|
HvHASKFLAGS_on(hv); |
3088
|
|
|
|
|
|
DEBUG_A(Perl_hv_assert(aTHX_ hv)); |
3089
|
|
|
|
|
|
|
3090
|
1917860
|
|
|
|
|
return hv; |
3091
|
|
|
|
|
|
} |
3092
|
|
|
|
|
|
|
3093
|
|
|
|
|
|
/* |
3094
|
|
|
|
|
|
=for apidoc m|SV *|refcounted_he_fetch_pvn|const struct refcounted_he *chain|const char *keypv|STRLEN keylen|U32 hash|U32 flags |
3095
|
|
|
|
|
|
|
3096
|
|
|
|
|
|
Search along a C chain for an entry with the key specified |
3097
|
|
|
|
|
|
by I and I. If I has the C |
3098
|
|
|
|
|
|
bit set, the key octets are interpreted as UTF-8, otherwise they |
3099
|
|
|
|
|
|
are interpreted as Latin-1. I is a precomputed hash of the key |
3100
|
|
|
|
|
|
string, or zero if it has not been precomputed. Returns a mortal scalar |
3101
|
|
|
|
|
|
representing the value associated with the key, or C<&PL_sv_placeholder> |
3102
|
|
|
|
|
|
if there is no value associated with the key. |
3103
|
|
|
|
|
|
|
3104
|
|
|
|
|
|
=cut |
3105
|
|
|
|
|
|
*/ |
3106
|
|
|
|
|
|
|
3107
|
|
|
|
|
|
SV * |
3108
|
15444236
|
|
|
|
|
Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain, |
3109
|
|
|
|
|
|
const char *keypv, STRLEN keylen, U32 hash, U32 flags) |
3110
|
|
|
|
|
|
{ |
3111
|
|
|
|
|
|
dVAR; |
3112
|
|
|
|
|
|
U8 utf8_flag; |
3113
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PVN; |
3114
|
|
|
|
|
|
|
3115
|
15444236
|
50
|
|
|
|
if (flags & ~(REFCOUNTED_HE_KEY_UTF8|REFCOUNTED_HE_EXISTS)) |
3116
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: refcounted_he_fetch_pvn bad flags %"UVxf, |
3117
|
|
|
|
|
|
(UV)flags); |
3118
|
15444236
|
100
|
|
|
|
if (!chain) |
3119
|
|
|
|
|
|
return &PL_sv_placeholder; |
3120
|
15444112
|
100
|
|
|
|
if (flags & REFCOUNTED_HE_KEY_UTF8) { |
3121
|
|
|
|
|
|
/* For searching purposes, canonicalise to Latin-1 where possible. */ |
3122
|
22
|
|
|
|
|
const char *keyend = keypv + keylen, *p; |
3123
|
|
|
|
|
|
STRLEN nonascii_count = 0; |
3124
|
118
|
100
|
|
|
|
for (p = keypv; p != keyend; p++) { |
3125
|
102
|
100
|
|
|
|
if (! UTF8_IS_INVARIANT(*p)) { |
3126
|
18
|
100
|
|
|
|
if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3127
|
|
|
|
|
|
goto canonicalised_key; |
3128
|
|
|
|
|
|
} |
3129
|
12
|
|
|
|
|
nonascii_count++; |
3130
|
12
|
|
|
|
|
p++; |
3131
|
|
|
|
|
|
} |
3132
|
|
|
|
|
|
} |
3133
|
16
|
100
|
|
|
|
if (nonascii_count) { |
3134
|
|
|
|
|
|
char *q; |
3135
|
12
|
|
|
|
|
const char *p = keypv, *keyend = keypv + keylen; |
3136
|
12
|
|
|
|
|
keylen -= nonascii_count; |
3137
|
12
|
|
|
|
|
Newx(q, keylen, char); |
3138
|
12
|
|
|
|
|
SAVEFREEPV(q); |
3139
|
|
|
|
|
|
keypv = q; |
3140
|
72
|
100
|
|
|
|
for (; p != keyend; p++, q++) { |
3141
|
60
|
|
|
|
|
U8 c = (U8)*p; |
3142
|
60
|
100
|
|
|
|
if (UTF8_IS_INVARIANT(c)) { |
3143
|
48
|
|
|
|
|
*q = (char) c; |
3144
|
|
|
|
|
|
} |
3145
|
|
|
|
|
|
else { |
3146
|
12
|
|
|
|
|
p++; |
3147
|
12
|
|
|
|
|
*q = (char) TWO_BYTE_UTF8_TO_NATIVE(c, *p); |
3148
|
|
|
|
|
|
} |
3149
|
|
|
|
|
|
} |
3150
|
|
|
|
|
|
} |
3151
|
16
|
|
|
|
|
flags &= ~REFCOUNTED_HE_KEY_UTF8; |
3152
|
|
|
|
|
|
canonicalised_key: ; |
3153
|
|
|
|
|
|
} |
3154
|
15444112
|
|
|
|
|
utf8_flag = (flags & REFCOUNTED_HE_KEY_UTF8) ? HVhek_UTF8 : 0; |
3155
|
15444112
|
50
|
|
|
|
if (!hash) |
3156
|
15444112
|
|
|
|
|
PERL_HASH(hash, keypv, keylen); |
3157
|
|
|
|
|
|
|
3158
|
8928516
|
100
|
|
|
|
for (; chain; chain = chain->refcounted_he_next) { |
3159
|
16600046
|
100
|
|
|
|
if ( |
3160
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3161
|
|
|
|
|
|
hash == chain->refcounted_he_hash && |
3162
|
|
|
|
|
|
keylen == chain->refcounted_he_keylen && |
3163
|
|
|
|
|
|
memEQ(REF_HE_KEY(chain), keypv, keylen) && |
3164
|
|
|
|
|
|
utf8_flag == (chain->refcounted_he_data[0] & HVhek_UTF8) |
3165
|
|
|
|
|
|
#else |
3166
|
23693613
|
50
|
|
|
|
hash == HEK_HASH(chain->refcounted_he_hek) && |
3167
|
23090385
|
50
|
|
|
|
keylen == (STRLEN)HEK_LEN(chain->refcounted_he_hek) && |
3168
|
23090385
|
100
|
|
|
|
memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) && |
3169
|
15393590
|
|
|
|
|
utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8) |
3170
|
|
|
|
|
|
#endif |
3171
|
|
|
|
|
|
) { |
3172
|
15393586
|
100
|
|
|
|
if (flags & REFCOUNTED_HE_EXISTS) |
3173
|
4968
|
|
|
|
|
return (chain->refcounted_he_data[0] & HVrhek_typemask) |
3174
|
|
|
|
|
|
== HVrhek_delete |
3175
|
3312
|
100
|
|
|
|
? NULL : &PL_sv_yes; |
3176
|
15390274
|
|
|
|
|
return sv_2mortal(refcounted_he_value(chain)); |
3177
|
|
|
|
|
|
} |
3178
|
|
|
|
|
|
} |
3179
|
7747381
|
50
|
|
|
|
return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder; |
3180
|
|
|
|
|
|
} |
3181
|
|
|
|
|
|
|
3182
|
|
|
|
|
|
/* |
3183
|
|
|
|
|
|
=for apidoc m|SV *|refcounted_he_fetch_pv|const struct refcounted_he *chain|const char *key|U32 hash|U32 flags |
3184
|
|
|
|
|
|
|
3185
|
|
|
|
|
|
Like L, but takes a nul-terminated string |
3186
|
|
|
|
|
|
instead of a string/length pair. |
3187
|
|
|
|
|
|
|
3188
|
|
|
|
|
|
=cut |
3189
|
|
|
|
|
|
*/ |
3190
|
|
|
|
|
|
|
3191
|
|
|
|
|
|
SV * |
3192
|
6
|
|
|
|
|
Perl_refcounted_he_fetch_pv(pTHX_ const struct refcounted_he *chain, |
3193
|
|
|
|
|
|
const char *key, U32 hash, U32 flags) |
3194
|
|
|
|
|
|
{ |
3195
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_PV; |
3196
|
6
|
|
|
|
|
return refcounted_he_fetch_pvn(chain, key, strlen(key), hash, flags); |
3197
|
|
|
|
|
|
} |
3198
|
|
|
|
|
|
|
3199
|
|
|
|
|
|
/* |
3200
|
|
|
|
|
|
=for apidoc m|SV *|refcounted_he_fetch_sv|const struct refcounted_he *chain|SV *key|U32 hash|U32 flags |
3201
|
|
|
|
|
|
|
3202
|
|
|
|
|
|
Like L, but takes a Perl scalar instead of a |
3203
|
|
|
|
|
|
string/length pair. |
3204
|
|
|
|
|
|
|
3205
|
|
|
|
|
|
=cut |
3206
|
|
|
|
|
|
*/ |
3207
|
|
|
|
|
|
|
3208
|
|
|
|
|
|
SV * |
3209
|
106
|
|
|
|
|
Perl_refcounted_he_fetch_sv(pTHX_ const struct refcounted_he *chain, |
3210
|
|
|
|
|
|
SV *key, U32 hash, U32 flags) |
3211
|
|
|
|
|
|
{ |
3212
|
|
|
|
|
|
const char *keypv; |
3213
|
|
|
|
|
|
STRLEN keylen; |
3214
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_FETCH_SV; |
3215
|
106
|
50
|
|
|
|
if (flags & REFCOUNTED_HE_KEY_UTF8) |
3216
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: refcounted_he_fetch_sv bad flags %"UVxf, |
3217
|
|
|
|
|
|
(UV)flags); |
3218
|
106
|
50
|
|
|
|
keypv = SvPV_const(key, keylen); |
3219
|
106
|
100
|
|
|
|
if (SvUTF8(key)) |
3220
|
2
|
|
|
|
|
flags |= REFCOUNTED_HE_KEY_UTF8; |
3221
|
106
|
50
|
|
|
|
if (!hash && SvIsCOW_shared_hash(key)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
3222
|
0
|
|
|
|
|
hash = SvSHARED_HASH(key); |
3223
|
106
|
|
|
|
|
return refcounted_he_fetch_pvn(chain, keypv, keylen, hash, flags); |
3224
|
|
|
|
|
|
} |
3225
|
|
|
|
|
|
|
3226
|
|
|
|
|
|
/* |
3227
|
|
|
|
|
|
=for apidoc m|struct refcounted_he *|refcounted_he_new_pvn|struct refcounted_he *parent|const char *keypv|STRLEN keylen|U32 hash|SV *value|U32 flags |
3228
|
|
|
|
|
|
|
3229
|
|
|
|
|
|
Creates a new C. This consists of a single key/value |
3230
|
|
|
|
|
|
pair and a reference to an existing C chain (which may |
3231
|
|
|
|
|
|
be empty), and thus forms a longer chain. When using the longer chain, |
3232
|
|
|
|
|
|
the new key/value pair takes precedence over any entry for the same key |
3233
|
|
|
|
|
|
further along the chain. |
3234
|
|
|
|
|
|
|
3235
|
|
|
|
|
|
The new key is specified by I and I. If I has |
3236
|
|
|
|
|
|
the C bit set, the key octets are interpreted |
3237
|
|
|
|
|
|
as UTF-8, otherwise they are interpreted as Latin-1. I is |
3238
|
|
|
|
|
|
a precomputed hash of the key string, or zero if it has not been |
3239
|
|
|
|
|
|
precomputed. |
3240
|
|
|
|
|
|
|
3241
|
|
|
|
|
|
I is the scalar value to store for this key. I is copied |
3242
|
|
|
|
|
|
by this function, which thus does not take ownership of any reference |
3243
|
|
|
|
|
|
to it, and later changes to the scalar will not be reflected in the |
3244
|
|
|
|
|
|
value visible in the C. Complex types of scalar will not |
3245
|
|
|
|
|
|
be stored with referential integrity, but will be coerced to strings. |
3246
|
|
|
|
|
|
I may be either null or C<&PL_sv_placeholder> to indicate that no |
3247
|
|
|
|
|
|
value is to be associated with the key; this, as with any non-null value, |
3248
|
|
|
|
|
|
takes precedence over the existence of a value for the key further along |
3249
|
|
|
|
|
|
the chain. |
3250
|
|
|
|
|
|
|
3251
|
|
|
|
|
|
I points to the rest of the C chain to be |
3252
|
|
|
|
|
|
attached to the new C. This function takes ownership |
3253
|
|
|
|
|
|
of one reference to I, and returns one reference to the new |
3254
|
|
|
|
|
|
C. |
3255
|
|
|
|
|
|
|
3256
|
|
|
|
|
|
=cut |
3257
|
|
|
|
|
|
*/ |
3258
|
|
|
|
|
|
|
3259
|
|
|
|
|
|
struct refcounted_he * |
3260
|
237456
|
|
|
|
|
Perl_refcounted_he_new_pvn(pTHX_ struct refcounted_he *parent, |
3261
|
|
|
|
|
|
const char *keypv, STRLEN keylen, U32 hash, SV *value, U32 flags) |
3262
|
|
|
|
|
|
{ |
3263
|
|
|
|
|
|
dVAR; |
3264
|
237456
|
|
|
|
|
STRLEN value_len = 0; |
3265
|
|
|
|
|
|
const char *value_p = NULL; |
3266
|
|
|
|
|
|
bool is_pv; |
3267
|
|
|
|
|
|
char value_type; |
3268
|
|
|
|
|
|
char hekflags; |
3269
|
|
|
|
|
|
STRLEN key_offset = 1; |
3270
|
|
|
|
|
|
struct refcounted_he *he; |
3271
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_PVN; |
3272
|
|
|
|
|
|
|
3273
|
237456
|
100
|
|
|
|
if (!value || value == &PL_sv_placeholder) { |
|
|
50
|
|
|
|
|
3274
|
|
|
|
|
|
value_type = HVrhek_delete; |
3275
|
205442
|
100
|
|
|
|
} else if (SvPOK(value)) { |
3276
|
|
|
|
|
|
value_type = HVrhek_PV; |
3277
|
85240
|
100
|
|
|
|
} else if (SvIOK(value)) { |
3278
|
83312
|
100
|
|
|
|
value_type = SvUOK((const SV *)value) ? HVrhek_UV : HVrhek_IV; |
3279
|
1928
|
100
|
|
|
|
} else if (!SvOK(value)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3280
|
|
|
|
|
|
value_type = HVrhek_undef; |
3281
|
|
|
|
|
|
} else { |
3282
|
|
|
|
|
|
value_type = HVrhek_PV; |
3283
|
|
|
|
|
|
} |
3284
|
237456
|
|
|
|
|
is_pv = value_type == HVrhek_PV; |
3285
|
237456
|
100
|
|
|
|
if (is_pv) { |
3286
|
|
|
|
|
|
/* Do it this way so that the SvUTF8() test is after the SvPV, in case |
3287
|
|
|
|
|
|
the value is overloaded, and doesn't yet have the UTF-8flag set. */ |
3288
|
122112
|
100
|
|
|
|
value_p = SvPV_const(value, value_len); |
3289
|
122112
|
100
|
|
|
|
if (SvUTF8(value)) |
3290
|
|
|
|
|
|
value_type = HVrhek_PV_UTF8; |
3291
|
122112
|
|
|
|
|
key_offset = value_len + 2; |
3292
|
|
|
|
|
|
} |
3293
|
|
|
|
|
|
hekflags = value_type; |
3294
|
|
|
|
|
|
|
3295
|
237456
|
100
|
|
|
|
if (flags & REFCOUNTED_HE_KEY_UTF8) { |
3296
|
|
|
|
|
|
/* Canonicalise to Latin-1 where possible. */ |
3297
|
18
|
|
|
|
|
const char *keyend = keypv + keylen, *p; |
3298
|
|
|
|
|
|
STRLEN nonascii_count = 0; |
3299
|
84
|
100
|
|
|
|
for (p = keypv; p != keyend; p++) { |
3300
|
74
|
100
|
|
|
|
if (! UTF8_IS_INVARIANT(*p)) { |
3301
|
16
|
100
|
|
|
|
if (! UTF8_IS_NEXT_CHAR_DOWNGRADEABLE(p, keyend)) { |
|
|
50
|
|
|
|
|
|
|
50
|
|
|
|
|
3302
|
|
|
|
|
|
goto canonicalised_key; |
3303
|
|
|
|
|
|
} |
3304
|
8
|
|
|
|
|
nonascii_count++; |
3305
|
8
|
|
|
|
|
p++; |
3306
|
|
|
|
|
|
} |
3307
|
|
|
|
|
|
} |
3308
|
10
|
100
|
|
|
|
if (nonascii_count) { |
3309
|
|
|
|
|
|
char *q; |
3310
|
8
|
|
|
|
|
const char *p = keypv, *keyend = keypv + keylen; |
3311
|
8
|
|
|
|
|
keylen -= nonascii_count; |
3312
|
8
|
|
|
|
|
Newx(q, keylen, char); |
3313
|
8
|
|
|
|
|
SAVEFREEPV(q); |
3314
|
|
|
|
|
|
keypv = q; |
3315
|
48
|
100
|
|
|
|
for (; p != keyend; p++, q++) { |
3316
|
40
|
|
|
|
|
U8 c = (U8)*p; |
3317
|
40
|
100
|
|
|
|
if (UTF8_IS_INVARIANT(c)) { |
3318
|
32
|
|
|
|
|
*q = (char) c; |
3319
|
|
|
|
|
|
} |
3320
|
|
|
|
|
|
else { |
3321
|
8
|
|
|
|
|
p++; |
3322
|
8
|
|
|
|
|
*q = (char) TWO_BYTE_UTF8_TO_NATIVE(c, *p); |
3323
|
|
|
|
|
|
} |
3324
|
|
|
|
|
|
} |
3325
|
|
|
|
|
|
} |
3326
|
10
|
|
|
|
|
flags &= ~REFCOUNTED_HE_KEY_UTF8; |
3327
|
|
|
|
|
|
canonicalised_key: ; |
3328
|
|
|
|
|
|
} |
3329
|
237456
|
100
|
|
|
|
if (flags & REFCOUNTED_HE_KEY_UTF8) |
3330
|
8
|
|
|
|
|
hekflags |= HVhek_UTF8; |
3331
|
237456
|
100
|
|
|
|
if (!hash) |
3332
|
236720
|
|
|
|
|
PERL_HASH(hash, keypv, keylen); |
3333
|
|
|
|
|
|
|
3334
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3335
|
|
|
|
|
|
he = (struct refcounted_he*) |
3336
|
|
|
|
|
|
PerlMemShared_malloc(sizeof(struct refcounted_he) - 1 |
3337
|
|
|
|
|
|
+ keylen |
3338
|
|
|
|
|
|
+ key_offset); |
3339
|
|
|
|
|
|
#else |
3340
|
237456
|
|
|
|
|
he = (struct refcounted_he*) |
3341
|
237456
|
|
|
|
|
PerlMemShared_malloc(sizeof(struct refcounted_he) - 1 |
3342
|
|
|
|
|
|
+ key_offset); |
3343
|
|
|
|
|
|
#endif |
3344
|
|
|
|
|
|
|
3345
|
237456
|
|
|
|
|
he->refcounted_he_next = parent; |
3346
|
|
|
|
|
|
|
3347
|
237456
|
100
|
|
|
|
if (is_pv) { |
3348
|
122112
|
|
|
|
|
Copy(value_p, he->refcounted_he_data + 1, value_len + 1, char); |
3349
|
122112
|
|
|
|
|
he->refcounted_he_val.refcounted_he_u_len = value_len; |
3350
|
115344
|
100
|
|
|
|
} else if (value_type == HVrhek_IV) { |
3351
|
83308
|
|
|
|
|
he->refcounted_he_val.refcounted_he_u_iv = SvIVX(value); |
3352
|
32036
|
100
|
|
|
|
} else if (value_type == HVrhek_UV) { |
3353
|
4
|
|
|
|
|
he->refcounted_he_val.refcounted_he_u_uv = SvUVX(value); |
3354
|
|
|
|
|
|
} |
3355
|
|
|
|
|
|
|
3356
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3357
|
|
|
|
|
|
he->refcounted_he_hash = hash; |
3358
|
|
|
|
|
|
he->refcounted_he_keylen = keylen; |
3359
|
|
|
|
|
|
Copy(keypv, he->refcounted_he_data + key_offset, keylen, char); |
3360
|
|
|
|
|
|
#else |
3361
|
237456
|
|
|
|
|
he->refcounted_he_hek = share_hek_flags(keypv, keylen, hash, hekflags); |
3362
|
|
|
|
|
|
#endif |
3363
|
|
|
|
|
|
|
3364
|
237456
|
|
|
|
|
he->refcounted_he_data[0] = hekflags; |
3365
|
237456
|
|
|
|
|
he->refcounted_he_refcnt = 1; |
3366
|
|
|
|
|
|
|
3367
|
237456
|
|
|
|
|
return he; |
3368
|
|
|
|
|
|
} |
3369
|
|
|
|
|
|
|
3370
|
|
|
|
|
|
/* |
3371
|
|
|
|
|
|
=for apidoc m|struct refcounted_he *|refcounted_he_new_pv|struct refcounted_he *parent|const char *key|U32 hash|SV *value|U32 flags |
3372
|
|
|
|
|
|
|
3373
|
|
|
|
|
|
Like L, but takes a nul-terminated string instead |
3374
|
|
|
|
|
|
of a string/length pair. |
3375
|
|
|
|
|
|
|
3376
|
|
|
|
|
|
=cut |
3377
|
|
|
|
|
|
*/ |
3378
|
|
|
|
|
|
|
3379
|
|
|
|
|
|
struct refcounted_he * |
3380
|
4
|
|
|
|
|
Perl_refcounted_he_new_pv(pTHX_ struct refcounted_he *parent, |
3381
|
|
|
|
|
|
const char *key, U32 hash, SV *value, U32 flags) |
3382
|
|
|
|
|
|
{ |
3383
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_PV; |
3384
|
4
|
|
|
|
|
return refcounted_he_new_pvn(parent, key, strlen(key), hash, value, flags); |
3385
|
|
|
|
|
|
} |
3386
|
|
|
|
|
|
|
3387
|
|
|
|
|
|
/* |
3388
|
|
|
|
|
|
=for apidoc m|struct refcounted_he *|refcounted_he_new_sv|struct refcounted_he *parent|SV *key|U32 hash|SV *value|U32 flags |
3389
|
|
|
|
|
|
|
3390
|
|
|
|
|
|
Like L, but takes a Perl scalar instead of a |
3391
|
|
|
|
|
|
string/length pair. |
3392
|
|
|
|
|
|
|
3393
|
|
|
|
|
|
=cut |
3394
|
|
|
|
|
|
*/ |
3395
|
|
|
|
|
|
|
3396
|
|
|
|
|
|
struct refcounted_he * |
3397
|
145010
|
|
|
|
|
Perl_refcounted_he_new_sv(pTHX_ struct refcounted_he *parent, |
3398
|
|
|
|
|
|
SV *key, U32 hash, SV *value, U32 flags) |
3399
|
|
|
|
|
|
{ |
3400
|
|
|
|
|
|
const char *keypv; |
3401
|
|
|
|
|
|
STRLEN keylen; |
3402
|
|
|
|
|
|
PERL_ARGS_ASSERT_REFCOUNTED_HE_NEW_SV; |
3403
|
145010
|
50
|
|
|
|
if (flags & REFCOUNTED_HE_KEY_UTF8) |
3404
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: refcounted_he_new_sv bad flags %"UVxf, |
3405
|
|
|
|
|
|
(UV)flags); |
3406
|
145010
|
50
|
|
|
|
keypv = SvPV_const(key, keylen); |
3407
|
145010
|
100
|
|
|
|
if (SvUTF8(key)) |
3408
|
4
|
|
|
|
|
flags |= REFCOUNTED_HE_KEY_UTF8; |
3409
|
145010
|
50
|
|
|
|
if (!hash && SvIsCOW_shared_hash(key)) |
|
|
100
|
|
|
|
|
|
|
50
|
|
|
|
|
3410
|
736
|
|
|
|
|
hash = SvSHARED_HASH(key); |
3411
|
145010
|
|
|
|
|
return refcounted_he_new_pvn(parent, keypv, keylen, hash, value, flags); |
3412
|
|
|
|
|
|
} |
3413
|
|
|
|
|
|
|
3414
|
|
|
|
|
|
/* |
3415
|
|
|
|
|
|
=for apidoc m|void|refcounted_he_free|struct refcounted_he *he |
3416
|
|
|
|
|
|
|
3417
|
|
|
|
|
|
Decrements the reference count of a C by one. If the |
3418
|
|
|
|
|
|
reference count reaches zero the structure's memory is freed, which |
3419
|
|
|
|
|
|
(recursively) causes a reduction of its parent C's |
3420
|
|
|
|
|
|
reference count. It is safe to pass a null pointer to this function: |
3421
|
|
|
|
|
|
no action occurs in this case. |
3422
|
|
|
|
|
|
|
3423
|
|
|
|
|
|
=cut |
3424
|
|
|
|
|
|
*/ |
3425
|
|
|
|
|
|
|
3426
|
|
|
|
|
|
void |
3427
|
76095932
|
|
|
|
|
Perl_refcounted_he_free(pTHX_ struct refcounted_he *he) { |
3428
|
|
|
|
|
|
dVAR; |
3429
|
|
|
|
|
|
PERL_UNUSED_CONTEXT; |
3430
|
|
|
|
|
|
|
3431
|
113061102
|
100
|
|
|
|
while (he) { |
3432
|
|
|
|
|
|
struct refcounted_he *copy; |
3433
|
|
|
|
|
|
U32 new_count; |
3434
|
|
|
|
|
|
|
3435
|
|
|
|
|
|
HINTS_REFCNT_LOCK; |
3436
|
1724316
|
|
|
|
|
new_count = --he->refcounted_he_refcnt; |
3437
|
|
|
|
|
|
HINTS_REFCNT_UNLOCK; |
3438
|
|
|
|
|
|
|
3439
|
1724316
|
100
|
|
|
|
if (new_count) { |
3440
|
76095932
|
|
|
|
|
return; |
3441
|
|
|
|
|
|
} |
3442
|
|
|
|
|
|
|
3443
|
|
|
|
|
|
#ifndef USE_ITHREADS |
3444
|
12204
|
|
|
|
|
unshare_hek_or_pvn (he->refcounted_he_hek, 0, 0, 0); |
3445
|
|
|
|
|
|
#endif |
3446
|
|
|
|
|
|
copy = he; |
3447
|
12204
|
|
|
|
|
he = he->refcounted_he_next; |
3448
|
12204
|
|
|
|
|
PerlMemShared_free(copy); |
3449
|
|
|
|
|
|
} |
3450
|
|
|
|
|
|
} |
3451
|
|
|
|
|
|
|
3452
|
|
|
|
|
|
/* |
3453
|
|
|
|
|
|
=for apidoc m|struct refcounted_he *|refcounted_he_inc|struct refcounted_he *he |
3454
|
|
|
|
|
|
|
3455
|
|
|
|
|
|
Increment the reference count of a C. The pointer to the |
3456
|
|
|
|
|
|
C is also returned. It is safe to pass a null pointer |
3457
|
|
|
|
|
|
to this function: no action occurs and a null pointer is returned. |
3458
|
|
|
|
|
|
|
3459
|
|
|
|
|
|
=cut |
3460
|
|
|
|
|
|
*/ |
3461
|
|
|
|
|
|
|
3462
|
|
|
|
|
|
struct refcounted_he * |
3463
|
150078523
|
|
|
|
|
Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he) |
3464
|
|
|
|
|
|
{ |
3465
|
|
|
|
|
|
dVAR; |
3466
|
150078523
|
100
|
|
|
|
if (he) { |
3467
|
|
|
|
|
|
HINTS_REFCNT_LOCK; |
3468
|
2545032
|
|
|
|
|
he->refcounted_he_refcnt++; |
3469
|
|
|
|
|
|
HINTS_REFCNT_UNLOCK; |
3470
|
|
|
|
|
|
} |
3471
|
150078523
|
|
|
|
|
return he; |
3472
|
|
|
|
|
|
} |
3473
|
|
|
|
|
|
|
3474
|
|
|
|
|
|
/* |
3475
|
|
|
|
|
|
=for apidoc cop_fetch_label |
3476
|
|
|
|
|
|
|
3477
|
|
|
|
|
|
Returns the label attached to a cop. |
3478
|
|
|
|
|
|
The flags pointer may be set to C or 0. |
3479
|
|
|
|
|
|
|
3480
|
|
|
|
|
|
=cut |
3481
|
|
|
|
|
|
*/ |
3482
|
|
|
|
|
|
|
3483
|
|
|
|
|
|
/* pp_entereval is aware that labels are stored with a key ':' at the top of |
3484
|
|
|
|
|
|
the linked list. */ |
3485
|
|
|
|
|
|
const char * |
3486
|
89148059
|
|
|
|
|
Perl_cop_fetch_label(pTHX_ COP *const cop, STRLEN *len, U32 *flags) { |
3487
|
89148059
|
|
|
|
|
struct refcounted_he *const chain = cop->cop_hints_hash; |
3488
|
|
|
|
|
|
|
3489
|
|
|
|
|
|
PERL_ARGS_ASSERT_COP_FETCH_LABEL; |
3490
|
|
|
|
|
|
|
3491
|
89148059
|
100
|
|
|
|
if (!chain) |
3492
|
|
|
|
|
|
return NULL; |
3493
|
|
|
|
|
|
#ifdef USE_ITHREADS |
3494
|
|
|
|
|
|
if (chain->refcounted_he_keylen != 1) |
3495
|
|
|
|
|
|
return NULL; |
3496
|
|
|
|
|
|
if (*REF_HE_KEY(chain) != ':') |
3497
|
|
|
|
|
|
return NULL; |
3498
|
|
|
|
|
|
#else |
3499
|
2157478
|
100
|
|
|
|
if ((STRLEN)HEK_LEN(chain->refcounted_he_hek) != 1) |
3500
|
|
|
|
|
|
return NULL; |
3501
|
438784
|
100
|
|
|
|
if (*HEK_KEY(chain->refcounted_he_hek) != ':') |
3502
|
|
|
|
|
|
return NULL; |
3503
|
|
|
|
|
|
#endif |
3504
|
|
|
|
|
|
/* Stop anyone trying to really mess us up by adding their own value for |
3505
|
|
|
|
|
|
':' into %^H */ |
3506
|
657387
|
50
|
|
|
|
if ((chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV |
3507
|
438738
|
|
|
|
|
&& (chain->refcounted_he_data[0] & HVrhek_typemask) != HVrhek_PV_UTF8) |
3508
|
|
|
|
|
|
return NULL; |
3509
|
|
|
|
|
|
|
3510
|
438738
|
100
|
|
|
|
if (len) |
3511
|
338042
|
|
|
|
|
*len = chain->refcounted_he_val.refcounted_he_u_len; |
3512
|
438738
|
100
|
|
|
|
if (flags) { |
3513
|
338042
|
100
|
|
|
|
*flags = ((chain->refcounted_he_data[0] & HVrhek_typemask) |
3514
|
|
|
|
|
|
== HVrhek_PV_UTF8) ? SVf_UTF8 : 0; |
3515
|
|
|
|
|
|
} |
3516
|
46025521
|
|
|
|
|
return chain->refcounted_he_data + 1; |
3517
|
|
|
|
|
|
} |
3518
|
|
|
|
|
|
|
3519
|
|
|
|
|
|
/* |
3520
|
|
|
|
|
|
=for apidoc cop_store_label |
3521
|
|
|
|
|
|
|
3522
|
|
|
|
|
|
Save a label into a C. You need to set flags to C |
3523
|
|
|
|
|
|
for a utf-8 label. |
3524
|
|
|
|
|
|
|
3525
|
|
|
|
|
|
=cut |
3526
|
|
|
|
|
|
*/ |
3527
|
|
|
|
|
|
|
3528
|
|
|
|
|
|
void |
3529
|
92402
|
|
|
|
|
Perl_cop_store_label(pTHX_ COP *const cop, const char *label, STRLEN len, |
3530
|
|
|
|
|
|
U32 flags) |
3531
|
|
|
|
|
|
{ |
3532
|
|
|
|
|
|
SV *labelsv; |
3533
|
|
|
|
|
|
PERL_ARGS_ASSERT_COP_STORE_LABEL; |
3534
|
|
|
|
|
|
|
3535
|
92402
|
50
|
|
|
|
if (flags & ~(SVf_UTF8)) |
3536
|
0
|
|
|
|
|
Perl_croak(aTHX_ "panic: cop_store_label illegal flag bits 0x%" UVxf, |
3537
|
|
|
|
|
|
(UV)flags); |
3538
|
92402
|
|
|
|
|
labelsv = newSVpvn_flags(label, len, SVs_TEMP); |
3539
|
92402
|
100
|
|
|
|
if (flags & SVf_UTF8) |
3540
|
358
|
|
|
|
|
SvUTF8_on(labelsv); |
3541
|
|
|
|
|
|
cop->cop_hints_hash |
3542
|
92402
|
|
|
|
|
= refcounted_he_new_pvs(cop->cop_hints_hash, ":", labelsv, 0); |
3543
|
92402
|
|
|
|
|
} |
3544
|
|
|
|
|
|
|
3545
|
|
|
|
|
|
/* |
3546
|
|
|
|
|
|
=for apidoc hv_assert |
3547
|
|
|
|
|
|
|
3548
|
|
|
|
|
|
Check that a hash is in an internally consistent state. |
3549
|
|
|
|
|
|
|
3550
|
|
|
|
|
|
=cut |
3551
|
|
|
|
|
|
*/ |
3552
|
|
|
|
|
|
|
3553
|
|
|
|
|
|
#ifdef DEBUGGING |
3554
|
|
|
|
|
|
|
3555
|
|
|
|
|
|
void |
3556
|
|
|
|
|
|
Perl_hv_assert(pTHX_ HV *hv) |
3557
|
|
|
|
|
|
{ |
3558
|
|
|
|
|
|
dVAR; |
3559
|
|
|
|
|
|
HE* entry; |
3560
|
|
|
|
|
|
int withflags = 0; |
3561
|
|
|
|
|
|
int placeholders = 0; |
3562
|
|
|
|
|
|
int real = 0; |
3563
|
|
|
|
|
|
int bad = 0; |
3564
|
|
|
|
|
|
const I32 riter = HvRITER_get(hv); |
3565
|
|
|
|
|
|
HE *eiter = HvEITER_get(hv); |
3566
|
|
|
|
|
|
|
3567
|
|
|
|
|
|
PERL_ARGS_ASSERT_HV_ASSERT; |
3568
|
|
|
|
|
|
|
3569
|
|
|
|
|
|
(void)hv_iterinit(hv); |
3570
|
|
|
|
|
|
|
3571
|
|
|
|
|
|
while ((entry = hv_iternext_flags(hv, HV_ITERNEXT_WANTPLACEHOLDERS))) { |
3572
|
|
|
|
|
|
/* sanity check the values */ |
3573
|
|
|
|
|
|
if (HeVAL(entry) == &PL_sv_placeholder) |
3574
|
|
|
|
|
|
placeholders++; |
3575
|
|
|
|
|
|
else |
3576
|
|
|
|
|
|
real++; |
3577
|
|
|
|
|
|
/* sanity check the keys */ |
3578
|
|
|
|
|
|
if (HeSVKEY(entry)) { |
3579
|
|
|
|
|
|
NOOP; /* Don't know what to check on SV keys. */ |
3580
|
|
|
|
|
|
} else if (HeKUTF8(entry)) { |
3581
|
|
|
|
|
|
withflags++; |
3582
|
|
|
|
|
|
if (HeKWASUTF8(entry)) { |
3583
|
|
|
|
|
|
PerlIO_printf(Perl_debug_log, |
3584
|
|
|
|
|
|
"hash key has both WASUTF8 and UTF8: '%.*s'\n", |
3585
|
|
|
|
|
|
(int) HeKLEN(entry), HeKEY(entry)); |
3586
|
|
|
|
|
|
bad = 1; |
3587
|
|
|
|
|
|
} |
3588
|
|
|
|
|
|
} else if (HeKWASUTF8(entry)) |
3589
|
|
|
|
|
|
withflags++; |
3590
|
|
|
|
|
|
} |
3591
|
|
|
|
|
|
if (!SvTIED_mg((const SV *)hv, PERL_MAGIC_tied)) { |
3592
|
|
|
|
|
|
static const char bad_count[] = "Count %d %s(s), but hash reports %d\n"; |
3593
|
|
|
|
|
|
const int nhashkeys = HvUSEDKEYS(hv); |
3594
|
|
|
|
|
|
const int nhashplaceholders = HvPLACEHOLDERS_get(hv); |
3595
|
|
|
|
|
|
|
3596
|
|
|
|
|
|
if (nhashkeys != real) { |
3597
|
|
|
|
|
|
PerlIO_printf(Perl_debug_log, bad_count, real, "keys", nhashkeys ); |
3598
|
|
|
|
|
|
bad = 1; |
3599
|
|
|
|
|
|
} |
3600
|
|
|
|
|
|
if (nhashplaceholders != placeholders) { |
3601
|
|
|
|
|
|
PerlIO_printf(Perl_debug_log, bad_count, placeholders, "placeholder", nhashplaceholders ); |
3602
|
|
|
|
|
|
bad = 1; |
3603
|
|
|
|
|
|
} |
3604
|
|
|
|
|
|
} |
3605
|
|
|
|
|
|
if (withflags && ! HvHASKFLAGS(hv)) { |
3606
|
|
|
|
|
|
PerlIO_printf(Perl_debug_log, |
3607
|
|
|
|
|
|
"Hash has HASKFLAGS off but I count %d key(s) with flags\n", |
3608
|
|
|
|
|
|
withflags); |
3609
|
|
|
|
|
|
bad = 1; |
3610
|
|
|
|
|
|
} |
3611
|
|
|
|
|
|
if (bad) { |
3612
|
|
|
|
|
|
sv_dump(MUTABLE_SV(hv)); |
3613
|
|
|
|
|
|
} |
3614
|
|
|
|
|
|
HvRITER_set(hv, riter); /* Restore hash iterator state */ |
3615
|
|
|
|
|
|
HvEITER_set(hv, eiter); |
3616
|
|
|
|
|
|
} |
3617
|
|
|
|
|
|
|
3618
|
|
|
|
|
|
#endif |
3619
|
|
|
|
|
|
|
3620
|
|
|
|
|
|
/* |
3621
|
|
|
|
|
|
* Local variables: |
3622
|
|
|
|
|
|
* c-indentation-style: bsd |
3623
|
|
|
|
|
|
* c-basic-offset: 4 |
3624
|
|
|
|
|
|
* indent-tabs-mode: nil |
3625
|
|
|
|
|
|
* End: |
3626
|
|
|
|
|
|
* |
3627
|
|
|
|
|
|
* ex: set ts=8 sts=4 sw=4 et: |
3628
|
|
|
|
|
|
*/ |