Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 3524 lines (3039 sloc) 97.751 kB
a0d0e21 perl 5.000
Larry Wall authored
1 /* hv.c
7907280 perl 5.0 alpha 2
Larry Wall authored
2 *
1129b88 Update copyright years.
Nicholas Clark authored
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
7907280 perl 5.0 alpha 2
Larry Wall authored
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 *
a0d0e21 perl 5.000
Larry Wall authored
9 */
10
11 /*
4ac7155 PATCH: Large omnibus patch to clean up the JRRT quotes
Tom Christiansen authored
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"]
7907280 perl 5.0 alpha 2
Larry Wall authored
17 */
18
d5afce7 Message-Id: <200201031449.OAA26137@tempest.npl.co.uk>
Robin Barker authored
19 /*
20 =head1 Hash Manipulation Functions
166f8a2 Add comment to the top of most .c files explaining their purpose
Dave Mitchell authored
21
db4fbf1 hv.c: Consistent spaces after dots in apidocs
Father Chrysostomos authored
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
166f8a2 Add comment to the top of most .c files explaining their purpose
Dave Mitchell authored
24 array is indexed by the hash function of the key, so each linked list
db4fbf1 hv.c: Consistent spaces after dots in apidocs
Father Chrysostomos authored
25 represents all the hash entries with the same hash value. Each HE contains
166f8a2 Add comment to the top of most .c files explaining their purpose
Dave Mitchell authored
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
d5afce7 Message-Id: <200201031449.OAA26137@tempest.npl.co.uk>
Robin Barker authored
31 */
32
7907280 perl 5.0 alpha 2
Larry Wall authored
33 #include "EXTERN.h"
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored
34 #define PERL_IN_HV_C
3d78eb9 Stas would prefer not to have MOD_PERL defines in perl.
Nicholas Clark authored
35 #define PERL_HASH_INTERNAL_ACCESS
7907280 perl 5.0 alpha 2
Larry Wall authored
36 #include "perl.h"
37
d8012aa 14 is the chain length for attack. From
Nicholas Clark authored
38 #define HV_MAX_LENGTH_BEFORE_SPLIT 14
fdcd69b Return 21533 (with modifications) having found the problem
Nicholas Clark authored
39
d75ce68 @petdance Better string constant in hv.c
petdance authored
40 static const char S_strtab_error[]
5d2b148 Croak if an attempt is made to modify PL_strtab
Nicholas Clark authored
41 = "Cannot modify shared string table in hv_%s";
42
c941fb5 Inlining del_HE is actually a space optimisation.
Nicholas Clark authored
43 #ifdef PURIFY
44
45 #define new_HE() (HE*)safemalloc(sizeof(HE))
46 #define del_HE(p) safefree((char*)p)
47
48 #else
49
76e3520 [asperl] added AS patch#2
Gurusamy Sarathy authored
50 STATIC HE*
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
51 S_new_he(pTHX)
4633a7c 5.002 beta 1
Larry Wall authored
52 {
97aff36 @jhi sprinkle dVAR
jhi authored
53 dVAR;
4633a7c 5.002 beta 1
Larry Wall authored
54 HE* he;
0bd4880 @petdance More consting, and putting stuff in embed.fnc
petdance authored
55 void ** const root = &PL_body_roots[HE_SVSLOT];
6a93a7e Map the HE arena onto SV type 0 (SVt_NULL).
Nicholas Clark authored
56
57 if (!*root)
1e30fcd Expose more_bodies(), and use it to replace S_more_he().
Nicholas Clark authored
58 Perl_more_bodies(aTHX_ HE_SVSLOT, sizeof(HE), PERL_ARENA_SIZE);
10edeb5 @jhi g++ large patch
jhi authored
59 he = (HE*) *root;
ce3e5c4 Add assertions to cover cases where the Coverity scanner thinks we
Nicholas Clark authored
60 assert(he);
6a93a7e Map the HE arena onto SV type 0 (SVt_NULL).
Nicholas Clark authored
61 *root = HeNEXT(he);
333f433 lock sv_mutex in new_he() and del_he() for USE_THREADS
Drago Goricanec authored
62 return he;
4633a7c 5.002 beta 1
Larry Wall authored
63 }
64
c941fb5 Inlining del_HE is actually a space optimisation.
Nicholas Clark authored
65 #define new_HE() new_he()
66 #define del_HE(p) \
67 STMT_START { \
6a93a7e Map the HE arena onto SV type 0 (SVt_NULL).
Nicholas Clark authored
68 HeNEXT(p) = (HE*)(PL_body_roots[HE_SVSLOT]); \
69 PL_body_roots[HE_SVSLOT] = p; \
c941fb5 Inlining del_HE is actually a space optimisation.
Nicholas Clark authored
70 } STMT_END
d33b2eb fix small interpreter leaks identified by Purify
Gurusamy Sarathy authored
71
72
73
74 #endif
75
76e3520 [asperl] added AS patch#2
Gurusamy Sarathy authored
76 STATIC HEK *
5f66b61 @petdance Trying my "remove the pTHXes" patch again
petdance authored
77 S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
bbce6d6 [inseparable changes from patch from perl5.003_08 to perl5.003_09]
Perl 5 Porters authored
78 {
35a4481 @petdance Adding const qualifiers
petdance authored
79 const int flags_masked = flags & HVhek_MASK;
bbce6d6 [inseparable changes from patch from perl5.003_08 to perl5.003_09]
Perl 5 Porters authored
80 char *k;
eb578fd Omnibus removal of register declarations
Karl Williamson authored
81 HEK *hek;
1c846c1 Hash lookup of constant strings optimization:
Nick Ing-Simmons authored
82
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
83 PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
84
a02a540 Re: janitorial work ? [patch]
Jim Cromie authored
85 Newx(k, HEK_BASESIZE + len + 2, char);
bbce6d6 [inseparable changes from patch from perl5.003_08 to perl5.003_09]
Perl 5 Porters authored
86 hek = (HEK*)k;
ff68c71 [inseparable changes from patch from perl5.003_09 to perl5.003_10]
Perl 5 Porters authored
87 Copy(str, HEK_KEY(hek), len, char);
e05949c @jhi Make shared hash keys to be \0-terminated:
jhi authored
88 HEK_KEY(hek)[len] = 0;
ff68c71 [inseparable changes from patch from perl5.003_09 to perl5.003_10]
Perl 5 Porters authored
89 HEK_LEN(hek) = len;
90 HEK_HASH(hek) = hash;
45e3480 Add a new hash key flag HVhek_UNSHARED, to mark all unshared hash keys.
Nicholas Clark authored
91 HEK_FLAGS(hek) = (unsigned char)flags_masked | HVhek_UNSHARED;
dcf933a S_save_hek_flags should honour the "free" flag.
Nicholas Clark authored
92
93 if (flags & HVhek_FREEKEY)
94 Safefree(str);
bbce6d6 [inseparable changes from patch from perl5.003_08 to perl5.003_09]
Perl 5 Porters authored
95 return hek;
96 }
97
4a31713 Fix typo in comment.
Nicholas Clark authored
98 /* free the pool of temporary HE/HEK pairs returned by hv_fetch_ent
dd28f7b allow recursive FETCHes
Dave Mitchell authored
99 * for tied hashes */
100
101 void
102 Perl_free_tied_hv_pool(pTHX)
103 {
97aff36 @jhi sprinkle dVAR
jhi authored
104 dVAR;
dd28f7b allow recursive FETCHes
Dave Mitchell authored
105 HE *he = PL_hv_fetch_ent_mh;
106 while (he) {
9d4ba2a @petdance We're going round in circles with pp_sys.c
petdance authored
107 HE * const ohe = he;
dd28f7b allow recursive FETCHes
Dave Mitchell authored
108 Safefree(HeKEY_hek(he));
109 he = HeNEXT(he);
110 del_HE(ohe);
111 }
4608196 @rgs More NullXXX macro removal from Andy Lester
rgs authored
112 PL_hv_fetch_ent_mh = NULL;
dd28f7b allow recursive FETCHes
Dave Mitchell authored
113 }
114
d18c611 preliminary support for perl_clone() (still needs work in
Gurusamy Sarathy authored
115 #if defined(USE_ITHREADS)
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
116 HEK *
117 Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param)
118 {
566771c Make Perl_hek_dup() cope with a NULL "source" parameter (by returning…
Nicholas Clark authored
119 HEK *shared;
9d4ba2a @petdance We're going round in circles with pp_sys.c
petdance authored
120
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
121 PERL_ARGS_ASSERT_HEK_DUP;
9d4ba2a @petdance We're going round in circles with pp_sys.c
petdance authored
122 PERL_UNUSED_ARG(param);
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
123
566771c Make Perl_hek_dup() cope with a NULL "source" parameter (by returning…
Nicholas Clark authored
124 if (!source)
125 return NULL;
126
127 shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
128 if (shared) {
129 /* We already shared this hash key. */
454f1e2 Silence yet more bcc32 compiler warnings
Steve Hay authored
130 (void)share_hek_hek(shared);
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
131 }
132 else {
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
133 shared
6e838c7 S_share_hek_flags can revert to returning a HEK
Nicholas Clark authored
134 = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
135 HEK_HASH(source), HEK_FLAGS(source));
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
136 ptr_table_store(PL_ptr_table, source, shared);
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
137 }
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
138 return shared;
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
139 }
140
d18c611 preliminary support for perl_clone() (still needs work in
Gurusamy Sarathy authored
141 HE *
5c4138a First argument to he_dup is actually a const HE *
Nicholas Clark authored
142 Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param)
d18c611 preliminary support for perl_clone() (still needs work in
Gurusamy Sarathy authored
143 {
144 HE *ret;
145
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
146 PERL_ARGS_ASSERT_HE_DUP;
147
d18c611 preliminary support for perl_clone() (still needs work in
Gurusamy Sarathy authored
148 if (!e)
4608196 @rgs More NullXXX macro removal from Andy Lester
rgs authored
149 return NULL;
7766f13 more complete pseudo-fork() support for Windows
Gurusamy Sarathy authored
150 /* look for it in the table first */
151 ret = (HE*)ptr_table_fetch(PL_ptr_table, e);
152 if (ret)
153 return ret;
154
155 /* create anew and remember what it is */
d33b2eb fix small interpreter leaks identified by Purify
Gurusamy Sarathy authored
156 ret = new_HE();
7766f13 more complete pseudo-fork() support for Windows
Gurusamy Sarathy authored
157 ptr_table_store(PL_ptr_table, e, ret);
158
d2d73c3 Fixes case of CvDEPTH for perl_clone
Artur Bergman authored
159 HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
dd28f7b allow recursive FETCHes
Dave Mitchell authored
160 if (HeKLEN(e) == HEf_SVKEY) {
161 char *k;
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
162 Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
dd28f7b allow recursive FETCHes
Dave Mitchell authored
163 HeKEY_hek(ret) = (HEK*)k;
a09252e Convert Perl_sv_dup_inc() from a macro to a real function.
Nicholas Clark authored
164 HeKEY_sv(ret) = sv_dup_inc(HeKEY_sv(e), param);
dd28f7b allow recursive FETCHes
Dave Mitchell authored
165 }
c21d1a0 Track the mapping between source shared hash keys and target shared
Nicholas Clark authored
166 else if (shared) {
0bff533 Export Perl_hek_dup, which duplicates shared hash keys.
Nicholas Clark authored
167 /* This is hek_dup inlined, which seems to be important for speed
168 reasons. */
1b6737c @petdance Const Boy II: The Localizing
petdance authored
169 HEK * const source = HeKEY_hek(e);
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
170 HEK *shared = (HEK*)ptr_table_fetch(PL_ptr_table, source);
c21d1a0 Track the mapping between source shared hash keys and target shared
Nicholas Clark authored
171
172 if (shared) {
173 /* We already shared this hash key. */
454f1e2 Silence yet more bcc32 compiler warnings
Steve Hay authored
174 (void)share_hek_hek(shared);
c21d1a0 Track the mapping between source shared hash keys and target shared
Nicholas Clark authored
175 }
176 else {
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
177 shared
6e838c7 S_share_hek_flags can revert to returning a HEK
Nicholas Clark authored
178 = share_hek_flags(HEK_KEY(source), HEK_LEN(source),
179 HEK_HASH(source), HEK_FLAGS(source));
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
180 ptr_table_store(PL_ptr_table, source, shared);
c21d1a0 Track the mapping between source shared hash keys and target shared
Nicholas Clark authored
181 }
658b4a4 hek_dup can now store the HEK rather than the HE, as there is now a
Nicholas Clark authored
182 HeKEY_hek(ret) = shared;
c21d1a0 Track the mapping between source shared hash keys and target shared
Nicholas Clark authored
183 }
d18c611 preliminary support for perl_clone() (still needs work in
Gurusamy Sarathy authored
184 else
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
185 HeKEY_hek(ret) = save_hek_flags(HeKEY(e), HeKLEN(e), HeHASH(e),
186 HeKFLAGS(e));
a09252e Convert Perl_sv_dup_inc() from a macro to a real function.
Nicholas Clark authored
187 HeVAL(ret) = sv_dup_inc(HeVAL(e), param);
d18c611 preliminary support for perl_clone() (still needs work in
Gurusamy Sarathy authored
188 return ret;
189 }
190 #endif /* USE_ITHREADS */
191
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
192 static void
2393f1b @jhi Make hv_notallowed a static as suggested by Nicholas Clark;
jhi authored
193 S_hv_notallowed(pTHX_ int flags, const char *key, I32 klen,
194 const char *msg)
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
195 {
1b6737c @petdance Const Boy II: The Localizing
petdance authored
196 SV * const sv = sv_newmortal();
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
197
198 PERL_ARGS_ASSERT_HV_NOTALLOWED;
199
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
200 if (!(flags & HVhek_FREEKEY)) {
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
201 sv_setpvn(sv, key, klen);
202 }
203 else {
204 /* Need to free saved eventually assign to mortal SV */
34c3c4e Re: the revenge of the bride of the son of the night of the living ps…
Dave Mitchell authored
205 /* XXX is this line an error ???: SV *sv = sv_newmortal(); */
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
206 sv_usepvn(sv, (char *) key, klen);
207 }
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
208 if (flags & HVhek_UTF8) {
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
209 SvUTF8_on(sv);
210 }
be2597d 4th patch from:
Marcus Holland-Moritz authored
211 Perl_croak(aTHX_ msg, SVfARG(sv));
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
212 }
213
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
214 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
215 * contains an SV* */
216
34a6f7b Reorder functions in hv.c so that callers of hv_fetch_common are all
Nicholas Clark authored
217 /*
218 =for apidoc hv_store
219
a05d6c5 @tonycoz document the behaviour of negative klen for hv_fetch and friends
tonycoz authored
220 Stores an SV in a hash. The hash key is specified as C<key> and the
221 absolute value of C<klen> is the length of the key. If C<klen> is
222 negative the key is assumed to be in UTF-8-encoded Unicode. The
223 C<hash> parameter is the precomputed hash value; if it is zero then
224 Perl will compute it.
225
226 The return value will be
34a6f7b Reorder functions in hv.c so that callers of hv_fetch_common are all
Nicholas Clark authored
227 NULL if the operation failed or if the value did not need to be actually
228 stored within the hash (as in the case of tied hashes). Otherwise it can
229 be dereferenced to get the original C<SV*>. Note that the caller is
230 responsible for suitably incrementing the reference count of C<val> before
231 the call, and decrementing it if the function returned NULL. Effectively
232 a successful hv_store takes ownership of one reference to C<val>. This is
233 usually what you want; a newly created SV has a reference count of one, so
234 if all your code does is create SVs then store them in a hash, hv_store
235 will own the only reference to the new SV, and your code doesn't need to do
236 anything further to tidy up. hv_store is not implemented as a call to
237 hv_store_ent, and does not create a temporary SV for the key, so if your
238 key data is not already in SV form then use hv_store in preference to
239 hv_store_ent.
240
241 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
242 information on how to use this function on tied hashes.
243
244 =for apidoc hv_store_ent
245
246 Stores C<val> in a hash. The hash key is specified as C<key>. The C<hash>
247 parameter is the precomputed hash value; if it is zero then Perl will
248 compute it. The return value is the new hash entry so created. It will be
249 NULL if the operation failed or if the value did not need to be actually
250 stored within the hash (as in the case of tied hashes). Otherwise the
251 contents of the return value can be accessed using the C<He?> macros
252 described here. Note that the caller is responsible for suitably
253 incrementing the reference count of C<val> before the call, and
254 decrementing it if the function returned NULL. Effectively a successful
255 hv_store_ent takes ownership of one reference to C<val>. This is
256 usually what you want; a newly created SV has a reference count of one, so
257 if all your code does is create SVs then store them in a hash, hv_store
258 will own the only reference to the new SV, and your code doesn't need to do
259 anything further to tidy up. Note that hv_store_ent only reads the C<key>;
260 unlike C<val> it does not take ownership of it, so maintaining the correct
261 reference count on C<key> is entirely the caller's responsibility. hv_store
262 is not implemented as a call to hv_store_ent, and does not create a temporary
263 SV for the key, so if your key data is not already in SV form then use
264 hv_store in preference to hv_store_ent.
265
266 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
267 information on how to use this function on tied hashes.
268
269 =for apidoc hv_exists
270
271 Returns a boolean indicating whether the specified hash key exists. The
a05d6c5 @tonycoz document the behaviour of negative klen for hv_fetch and friends
tonycoz authored
272 absolute value of C<klen> is the length of the key. If C<klen> is
273 negative the key is assumed to be in UTF-8-encoded Unicode.
34a6f7b Reorder functions in hv.c so that callers of hv_fetch_common are all
Nicholas Clark authored
274
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
275 =for apidoc hv_fetch
276
a05d6c5 @tonycoz document the behaviour of negative klen for hv_fetch and friends
tonycoz authored
277 Returns the SV which corresponds to the specified key in the hash.
278 The absolute value of C<klen> is the length of the key. If C<klen> is
279 negative the key is assumed to be in UTF-8-encoded Unicode. If
43d3b06 perlapi: Clarify hv_fetch() docs
Karl Williamson authored
280 C<lval> is set then the fetch will be part of a store. This means that if
281 there is no value in the hash associated with the given key, then one is
282 created and a pointer to it is returned. The C<SV*> it points to can be
283 assigned to. But always check that the
a05d6c5 @tonycoz document the behaviour of negative klen for hv_fetch and friends
tonycoz authored
284 return value is non-null before dereferencing it to an C<SV*>.
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
285
96f1132 documentation patches (from Michael Schwern and Yitzchak
Gurusamy Sarathy authored
286 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
287 information on how to use this function on tied hashes.
288
34a6f7b Reorder functions in hv.c so that callers of hv_fetch_common are all
Nicholas Clark authored
289 =for apidoc hv_exists_ent
290
db4fbf1 hv.c: Consistent spaces after dots in apidocs
Father Chrysostomos authored
291 Returns a boolean indicating whether
292 the specified hash key exists. C<hash>
34a6f7b Reorder functions in hv.c so that callers of hv_fetch_common are all
Nicholas Clark authored
293 can be a valid precomputed hash value, or 0 to ask for it to be
294 computed.
295
296 =cut
297 */
298
d1be940 a few typo fixes
Jeffrey Friedl authored
299 /* returns an HE * structure with the all fields set */
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
300 /* note that hent_val will be a mortal sv for MAGICAL hashes */
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
301 /*
302 =for apidoc hv_fetch_ent
303
304 Returns the hash entry which corresponds to the specified key in the hash.
305 C<hash> must be a valid precomputed hash number for the given C<key>, or 0
306 if you want the function to compute it. IF C<lval> is set then the fetch
307 will be part of a store. Make sure the return value is non-null before
b24b84e @iabyn fix hv.c API doc nits.
iabyn authored
308 accessing it. The return value when C<hv> is a tied hash is a pointer to a
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
309 static location, so be sure to make a copy of the structure if you need to
1c846c1 Hash lookup of constant strings optimization:
Nick Ing-Simmons authored
310 store it somewhere.
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
311
96f1132 documentation patches (from Michael Schwern and Yitzchak
Gurusamy Sarathy authored
312 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
313 information on how to use this function on tied hashes.
314
315 =cut
316 */
317
a038e57 Add a new function Perl_hv_common_key_len(), which contains the
Nicholas Clark authored
318 /* Common code for hv_delete()/hv_exists()/hv_fetch()/hv_store() */
319 void *
320 Perl_hv_common_key_len(pTHX_ HV *hv, const char *key, I32 klen_i32,
321 const int action, SV *val, const U32 hash)
322 {
323 STRLEN klen;
324 int flags;
325
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
326 PERL_ARGS_ASSERT_HV_COMMON_KEY_LEN;
327
a038e57 Add a new function Perl_hv_common_key_len(), which contains the
Nicholas Clark authored
328 if (klen_i32 < 0) {
329 klen = -klen_i32;
330 flags = HVhek_UTF8;
331 } else {
332 klen = klen_i32;
333 flags = 0;
334 }
335 return hv_common(hv, NULL, key, klen, flags, action, val, hash);
336 }
337
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
338 void *
d3ba3f5 Make hv_fetch_common() non-static, and change its name to hv_common(),
Nicholas Clark authored
339 Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
340 int flags, int action, SV *val, register U32 hash)
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
341 {
27da23d @jhi Symbian port of Perl
jhi authored
342 dVAR;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
343 XPVHV* xhv;
344 HE *entry;
345 HE **oentry;
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
346 SV *sv;
da58a35 @jhi UTF-8 hash keys, patch from Inaba Hiroto.
jhi authored
347 bool is_utf8;
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
348 int masked_flags;
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
349 const int return_svp = action & HV_FETCH_JUST_SV;
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
350
351 if (!hv)
a4fc7ab @petdance hv_fetchs() support
petdance authored
352 return NULL;
e4787c0 @chipdude SVTYPEMASK must be cast to (svtype) when comparing to SvTYPE()
chipdude authored
353 if (SvTYPE(hv) == (svtype)SVTYPEMASK)
8265e3d assert that what is passed into the hash functions is really an HV.
Nicholas Clark authored
354 return NULL;
355
356 assert(SvTYPE(hv) == SVt_PVHV);
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
357
bdee33e Call the key transformation function for hv_exists()/hv_fetch()/
Nicholas Clark authored
358 if (SvSMAGICAL(hv) && SvGMAGICAL(hv) && !(action & HV_DISABLE_UVAR_XKEY)) {
fda2d18 Inline and abolish S_hv_magic_uvar_xkey().
Nicholas Clark authored
359 MAGIC* mg;
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
360 if ((mg = mg_find((const SV *)hv, PERL_MAGIC_uvar))) {
fda2d18 Inline and abolish S_hv_magic_uvar_xkey().
Nicholas Clark authored
361 struct ufuncs * const uf = (struct ufuncs *)mg->mg_ptr;
362 if (uf->uf_set == NULL) {
363 SV* obj = mg->mg_obj;
364
365 if (!keysv) {
59cd0e2 Extend newSVpvn_flags() to also call sv_2mortal() if SVs_TEMP is set in
Nicholas Clark authored
366 keysv = newSVpvn_flags(key, klen, SVs_TEMP |
367 ((flags & HVhek_UTF8)
368 ? SVf_UTF8 : 0));
fda2d18 Inline and abolish S_hv_magic_uvar_xkey().
Nicholas Clark authored
369 }
370
371 mg->mg_obj = keysv; /* pass key */
372 uf->uf_index = action; /* pass action */
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
373 magic_getuvar(MUTABLE_SV(hv), mg);
fda2d18 Inline and abolish S_hv_magic_uvar_xkey().
Nicholas Clark authored
374 keysv = mg->mg_obj; /* may have changed */
375 mg->mg_obj = obj;
376
377 /* If the key may have changed, then we need to invalidate
378 any passed-in computed hash value. */
379 hash = 0;
380 }
381 }
bdee33e Call the key transformation function for hv_exists()/hv_fetch()/
Nicholas Clark authored
382 }
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
383 if (keysv) {
e593d2f Re: Change 21862
Adrian M. Enache authored
384 if (flags & HVhek_FREEKEY)
385 Safefree(key);
5c144d8 Lots of consting
Nicholas Clark authored
386 key = SvPV_const(keysv, klen);
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
387 is_utf8 = (SvUTF8(keysv) != 0);
44b87b5 Add a key flag HVhek_KEYCANONICAL for Perl_hv_common(), which signals…
Nicholas Clark authored
388 if (SvIsCOW_shared_hash(keysv)) {
389 flags = HVhek_KEYCANONICAL | (is_utf8 ? HVhek_UTF8 : 0);
390 } else {
391 flags = 0;
392 }
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
393 } else {
c1fe551 Shift negative klen/flags games from hv_fetch_common out to hv_fetch
Nicholas Clark authored
394 is_utf8 = ((flags & HVhek_UTF8) ? TRUE : FALSE);
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
395 }
396
9dbc560 Send all delete()/delete_ent() calls via S_hv_fetch_common().
Nicholas Clark authored
397 if (action & HV_DELETE) {
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
398 return (void *) hv_delete_common(hv, keysv, key, klen,
399 flags | (is_utf8 ? HVhek_UTF8 : 0),
400 action, hash);
9dbc560 Send all delete()/delete_ent() calls via S_hv_fetch_common().
Nicholas Clark authored
401 }
402
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
403 xhv = (XPVHV*)SvANY(hv);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
404 if (SvMAGICAL(hv)) {
6136c70 @petdance It's the Barbie bus patch
petdance authored
405 if (SvRMAGICAL(hv) && !(action & (HV_FETCH_ISSTORE|HV_FETCH_ISEXISTS))) {
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
406 if (mg_find((const SV *)hv, PERL_MAGIC_tied)
407 || SvGMAGICAL((const SV *)hv))
e62cc96 @demerphq Re: [perl #40468] Not OK: perl 5.9.4 +patchaperlup: on i686-linux-64i…
demerphq authored
408 {
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
409 /* FIXME should be able to skimp on the HE/HEK here when
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
410 HV_FETCH_JUST_SV is true. */
411 if (!keysv) {
740cce1 Add a new function newSVpvn_flags(), which takes a third parameter of
Nicholas Clark authored
412 keysv = newSVpvn_utf8(key, klen, is_utf8);
413 } else {
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
414 keysv = newSVsv(keysv);
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
415 }
44a2ac7 @demerphq Re: [PATCH] Change implementation of %+ to use a proper tied hash int…
demerphq authored
416 sv = sv_newmortal();
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
417 mg_copy(MUTABLE_SV(hv), sv, (char *)keysv, HEf_SVKEY);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
418
419 /* grab a fake HE/HEK pair from the pool or make a new one */
420 entry = PL_hv_fetch_ent_mh;
421 if (entry)
422 PL_hv_fetch_ent_mh = HeNEXT(entry);
423 else {
424 char *k;
425 entry = new_HE();
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
426 Newx(k, HEK_BASESIZE + sizeof(const SV *), char);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
427 HeKEY_hek(entry) = (HEK*)k;
428 }
4608196 @rgs More NullXXX macro removal from Andy Lester
rgs authored
429 HeNEXT(entry) = NULL;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
430 HeSVKEY_set(entry, keysv);
431 HeVAL(entry) = sv;
432 sv_upgrade(sv, SVt_PVLV);
433 LvTYPE(sv) = 'T';
434 /* so we can free entry when freeing sv */
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
435 LvTARG(sv) = MUTABLE_SV(entry);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
436
437 /* XXX remove at some point? */
438 if (flags & HVhek_FREEKEY)
439 Safefree(key);
440
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
441 if (return_svp) {
442 return entry ? (void *) &HeVAL(entry) : NULL;
443 }
444 return (void *) entry;
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
445 }
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
446 #ifdef ENV_IS_CASELESS
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
447 else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
448 U32 i;
449 for (i = 0; i < klen; ++i)
450 if (isLOWER(key[i])) {
086cb32 Some fool missed a letter n.
Nicholas Clark authored
451 /* Would be nice if we had a routine to do the
452 copy and upercase in a single pass through. */
0bd4880 @petdance More consting, and putting stuff in embed.fnc
petdance authored
453 const char * const nkey = strupr(savepvn(key,klen));
086cb32 Some fool missed a letter n.
Nicholas Clark authored
454 /* Note that this fetch is for nkey (the uppercased
455 key) whereas the store is for key (the original) */
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
456 void *result = hv_common(hv, NULL, nkey, klen,
457 HVhek_FREEKEY, /* free nkey */
458 0 /* non-LVAL fetch */
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
459 | HV_DISABLE_UVAR_XKEY
460 | return_svp,
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
461 NULL /* no value */,
462 0 /* compute hash */);
26488bc Fix Win32 breakage caused by #31926
Steve Hay authored
463 if (!result && (action & HV_FETCH_LVALUE)) {
086cb32 Some fool missed a letter n.
Nicholas Clark authored
464 /* This call will free key if necessary.
465 Do it this way to encourage compiler to tail
466 call optimise. */
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
467 result = hv_common(hv, keysv, key, klen, flags,
468 HV_FETCH_ISSTORE
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
469 | HV_DISABLE_UVAR_XKEY
470 | return_svp,
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
471 newSV(0), hash);
086cb32 Some fool missed a letter n.
Nicholas Clark authored
472 } else {
473 if (flags & HVhek_FREEKEY)
474 Safefree(key);
475 }
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
476 return result;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
477 }
902173a [win32] Support case-tolerant %ENV
Gurusamy Sarathy authored
478 }
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
479 #endif
480 } /* ISFETCH */
481 else if (SvRMAGICAL(hv) && (action & HV_FETCH_ISEXISTS)) {
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
482 if (mg_find((const SV *)hv, PERL_MAGIC_tied)
483 || SvGMAGICAL((const SV *)hv)) {
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
484 /* I don't understand why hv_exists_ent has svret and sv,
485 whereas hv_exists only had one. */
9d4ba2a @petdance We're going round in circles with pp_sys.c
petdance authored
486 SV * const svret = sv_newmortal();
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
487 sv = sv_newmortal();
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
488
489 if (keysv || is_utf8) {
490 if (!keysv) {
740cce1 Add a new function newSVpvn_flags(), which takes a third parameter of
Nicholas Clark authored
491 keysv = newSVpvn_utf8(key, klen, TRUE);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
492 } else {
493 keysv = newSVsv(keysv);
494 }
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
495 mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
496 } else {
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
497 mg_copy(MUTABLE_SV(hv), sv, key, klen);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
498 }
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
499 if (flags & HVhek_FREEKEY)
500 Safefree(key);
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
501 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. */
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
505 return SvTRUE(svret) ? (void *)hv : NULL;
e7152ba [win32] tweak case-insensitive ENV implementation
Gurusamy Sarathy authored
506 }
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
507 #ifdef ENV_IS_CASELESS
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
508 else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
509 /* XXX This code isn't UTF8 clean. */
a15d23f Stop "suspicious pointer conversion" warning following change 24997
Steve Hay authored
510 char * const keysave = (char * const)key;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
511 /* Will need to free this, so set FREEKEY flag. */
512 key = savepvn(key,klen);
513 key = (const char*)strupr((char*)key);
6136c70 @petdance It's the Barbie bus patch
petdance authored
514 is_utf8 = FALSE;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
515 hash = 0;
8b4f7dd Stop ENV_IS_CASELESS hv.c picking up the wrong hash value from a
Nicholas Clark authored
516 keysv = 0;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
517
518 if (flags & HVhek_FREEKEY) {
519 Safefree(keysave);
520 }
521 flags |= HVhek_FREEKEY;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
522 }
902173a [win32] Support case-tolerant %ENV
Gurusamy Sarathy authored
523 #endif
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
524 } /* ISEXISTS */
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
525 else if (action & HV_FETCH_ISSTORE) {
526 bool needs_copy;
527 bool needs_store;
528 hv_magic_check (hv, &needs_copy, &needs_store);
529 if (needs_copy) {
a3b680e @petdance consting-eleventy.patch: More consts, plus actual bug fix
petdance authored
530 const bool save_taint = PL_tainted;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
531 if (keysv || is_utf8) {
532 if (!keysv) {
740cce1 Add a new function newSVpvn_flags(), which takes a third parameter of
Nicholas Clark authored
533 keysv = newSVpvn_utf8(key, klen, TRUE);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
534 }
535 if (PL_tainting)
536 PL_tainted = SvTAINTED(keysv);
537 keysv = sv_2mortal(newSVsv(keysv));
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
538 mg_copy(MUTABLE_SV(hv), val, (char*)keysv, HEf_SVKEY);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
539 } else {
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
540 mg_copy(MUTABLE_SV(hv), val, key, klen);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
541 }
542
543 TAINT_IF(save_taint);
1baaf5d Fix bug 36267 - assigning to a tied hash shouldn't change the
Nicholas Clark authored
544 if (!needs_store) {
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
545 if (flags & HVhek_FREEKEY)
546 Safefree(key);
4608196 @rgs More NullXXX macro removal from Andy Lester
rgs authored
547 return NULL;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
548 }
549 #ifdef ENV_IS_CASELESS
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
550 else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
551 /* XXX This code isn't UTF8 clean. */
552 const char *keysave = key;
553 /* Will need to free this, so set FREEKEY flag. */
554 key = savepvn(key,klen);
555 key = (const char*)strupr((char*)key);
6136c70 @petdance It's the Barbie bus patch
petdance authored
556 is_utf8 = FALSE;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
557 hash = 0;
8b4f7dd Stop ENV_IS_CASELESS hv.c picking up the wrong hash value from a
Nicholas Clark authored
558 keysv = 0;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
559
560 if (flags & HVhek_FREEKEY) {
561 Safefree(keysave);
562 }
563 flags |= HVhek_FREEKEY;
564 }
565 #endif
566 }
567 } /* ISSTORE */
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
568 } /* SvMAGICAL */
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
569
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
570 if (!HvARRAY(hv)) {
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
571 if ((action & (HV_FETCH_LVALUE | HV_FETCH_ISSTORE))
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
572 #ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
573 || (SvRMAGICAL((const SV *)hv)
574 && mg_find((const SV *)hv, PERL_MAGIC_env))
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
575 #endif
d58e666 As PERL_HV_ARRAY_ALLOC_BYTES is bytes, not items, the type should be
Nicholas Clark authored
576 ) {
577 char *array;
a02a540 Re: janitorial work ? [patch]
Jim Cromie authored
578 Newxz(array,
cbec934 @jhi Revert #10656 for performance reasons but leave in the
jhi authored
579 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
d58e666 As PERL_HV_ARRAY_ALLOC_BYTES is bytes, not items, the type should be
Nicholas Clark authored
580 char);
581 HvARRAY(hv) = (HE**)array;
582 }
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
583 #ifdef DYNAMIC_ENV_FETCH
584 else if (action & HV_FETCH_ISEXISTS) {
585 /* for an %ENV exists, if we do an insert it's by a recursive
586 store call, so avoid creating HvARRAY(hv) right now. */
587 }
588 #endif
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
589 else {
590 /* XXX remove at some point? */
591 if (flags & HVhek_FREEKEY)
592 Safefree(key);
593
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
594 return NULL;
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
595 }
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
596 }
597
44b87b5 Add a key flag HVhek_KEYCANONICAL for Perl_hv_common(), which signals…
Nicholas Clark authored
598 if (is_utf8 & !(flags & HVhek_KEYCANONICAL)) {
41d88b6 Avoid a warning from the Irix C compiler.
Nicholas Clark authored
599 char * const keysave = (char *)key;
f9a6324 @jhi Patch from Inaba Hiroto:
jhi authored
600 key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
601 if (is_utf8)
c1fe551 Shift negative klen/flags games from hv_fetch_common out to hv_fetch
Nicholas Clark authored
602 flags |= HVhek_UTF8;
603 else
604 flags &= ~HVhek_UTF8;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
605 if (key != keysave) {
606 if (flags & HVhek_FREEKEY)
607 Safefree(keysave);
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
608 flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
527df57 Precomputing the hash value for a string representable in bytes, but …
Nicholas Clark authored
609 /* If the caller calculated a hash, it was on the sequence of
610 octets that are the UTF-8 form. We've now changed the sequence
611 of octets stored to that of the equivalent byte representation,
612 so the hash we need is different. */
613 hash = 0;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
614 }
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
615 }
f9a6324 @jhi Patch from Inaba Hiroto:
jhi authored
616
f8d50d9 @iabyn unify PERL_HASH and PERL_HASH_INTERNAL
iabyn authored
617 if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
618 PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
619 else if (!hash)
620 hash = SvSHARED_HASH(keysv);
621
622 /* We don't have a pointer to the hv, so we have to replicate the
623 flag into every HEK, so that hv_iterkeysv can see it.
624 And yes, you do need this even though you are not "storing" because
625 you can flip the flags below if doing an lval lookup. (And that
626 was put in to give the semantics Andreas was expecting.) */
627 if (HvREHASH(hv))
fdcd69b Return 21533 (with modifications) having found the problem
Nicholas Clark authored
628 flags |= HVhek_REHASH;
effa1e2 perl 5.003_05: hv.c
Perl 5 Porters authored
629
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
630 masked_flags = (flags & HVhek_MASK);
631
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
632 #ifdef DYNAMIC_ENV_FETCH
4608196 @rgs More NullXXX macro removal from Andy Lester
rgs authored
633 if (!HvARRAY(hv)) entry = NULL;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
634 else
635 #endif
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
636 {
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
637 entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)];
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
638 }
0298d7b Avoid updating a variable in a loop.
Nicholas Clark authored
639 for (; entry; entry = HeNEXT(entry)) {
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
640 if (HeHASH(entry) != hash) /* strings can't be equal */
641 continue;
eb16046 fixes for all the warnings reported by Visual C (most of this
Gurusamy Sarathy authored
642 if (HeKLEN(entry) != (I32)klen)
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
643 continue;
1c846c1 Hash lookup of constant strings optimization:
Nick Ing-Simmons authored
644 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
645 continue;
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
646 if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
c3654f1 @Inaba-Hiroto Additional patch for UTF8-keys (Re: perl@8016)
Inaba-Hiroto authored
647 continue;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
648
649 if (action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE)) {
650 if (HeKFLAGS(entry) != masked_flags) {
651 /* We match if HVhek_UTF8 bit in our flags and hash key's
652 match. But if entry was set previously with HVhek_WASUTF8
653 and key now doesn't (or vice versa) then we should change
654 the key's flag, as this is assignment. */
655 if (HvSHAREKEYS(hv)) {
656 /* Need to swap the key we have for a key with the flags we
657 need. As keys are shared we can't just write to the
658 flag, so we share the new one, unshare the old one. */
6136c70 @petdance It's the Barbie bus patch
petdance authored
659 HEK * const new_hek = share_hek_flags(key, klen, hash,
6e838c7 S_share_hek_flags can revert to returning a HEK
Nicholas Clark authored
660 masked_flags);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
661 unshare_hek (HeKEY_hek(entry));
662 HeKEY_hek(entry) = new_hek;
663 }
5d2b148 Croak if an attempt is made to modify PL_strtab
Nicholas Clark authored
664 else if (hv == PL_strtab) {
665 /* PL_strtab is usually the only hash without HvSHAREKEYS,
666 so putting this test here is cheap */
667 if (flags & HVhek_FREEKEY)
668 Safefree(key);
669 Perl_croak(aTHX_ S_strtab_error,
670 action & HV_FETCH_LVALUE ? "fetch" : "store");
671 }
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
672 else
673 HeKFLAGS(entry) = masked_flags;
674 if (masked_flags & HVhek_ENABLEHVKFLAGS)
675 HvHASKFLAGS_on(hv);
676 }
677 if (HeVAL(entry) == &PL_sv_placeholder) {
678 /* yes, can store into placeholder slot */
679 if (action & HV_FETCH_LVALUE) {
680 if (SvMAGICAL(hv)) {
681 /* This preserves behaviour with the old hv_fetch
682 implementation which at this point would bail out
683 with a break; (at "if we find a placeholder, we
684 pretend we haven't found anything")
685
686 That break mean that if a placeholder were found, it
687 caused a call into hv_store, which in turn would
688 check magic, and if there is no magic end up pretty
689 much back at this point (in hv_store's code). */
690 break;
691 }
486ec47 Fix typos (spelling errors) in Perl sources.
Peter J. Acklam) (via RT authored
692 /* LVAL fetch which actually needs a store. */
561b68a Change all NEWSV() to newSV() in the core and non-dual-lived modules.
Steve Hay authored
693 val = newSV(0);
ca73285 Move placeholders into a new rhash magic type.
Nicholas Clark authored
694 HvPLACEHOLDERS(hv)--;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
695 } else {
696 /* store */
697 if (val != &PL_sv_placeholder)
ca73285 Move placeholders into a new rhash magic type.
Nicholas Clark authored
698 HvPLACEHOLDERS(hv)--;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
699 }
700 HeVAL(entry) = val;
701 } else if (action & HV_FETCH_ISSTORE) {
cefd5c7 [perl #78488] Bleadperl 304474c3 breaks GFUJI/Test-LeakTrace-0.13.tar.gz
Father Chrysostomos authored
702 SvREFCNT_dec(HeVAL(entry));
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
703 HeVAL(entry) = val;
704 }
27bcc0a @rgs Revert change 23843.
rgs authored
705 } else if (HeVAL(entry) == &PL_sv_placeholder) {
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
706 /* if we find a placeholder, we pretend we haven't found
707 anything */
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
708 break;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
709 }
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
710 if (flags & HVhek_FREEKEY)
711 Safefree(key);
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
712 if (return_svp) {
713 return entry ? (void *) &HeVAL(entry) : NULL;
714 }
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
715 return entry;
716 }
717 #ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
0ed2995 Should fix the infinite loop on a dynamic %ENV fetch
Nicholas Clark authored
718 if (!(action & HV_FETCH_ISSTORE)
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
719 && SvRMAGICAL((const SV *)hv)
720 && mg_find((const SV *)hv, PERL_MAGIC_env)) {
a6c4036 various fixes for clean build and test on win32; configpm broken,
Gurusamy Sarathy authored
721 unsigned long len;
9d4ba2a @petdance We're going round in circles with pp_sys.c
petdance authored
722 const char * const env = PerlEnv_ENVgetenv_len(key,&len);
a6c4036 various fixes for clean build and test on win32; configpm broken,
Gurusamy Sarathy authored
723 if (env) {
724 sv = newSVpvn(env,len);
725 SvTAINTED_on(sv);
d3ba3f5 Make hv_fetch_common() non-static, and change its name to hv_common(),
Nicholas Clark authored
726 return hv_common(hv, keysv, key, klen, flags,
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
727 HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp,
728 sv, hash);
a6c4036 various fixes for clean build and test on win32; configpm broken,
Gurusamy Sarathy authored
729 }
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
730 }
731 #endif
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
732
733 if (!entry && SvREADONLY(hv) && !(action & HV_FETCH_ISEXISTS)) {
c445ea1 @petdance Ho! Ho! Ho! Santa brings consting!
petdance authored
734 hv_notallowed(flags, key, klen,
c8cd646 Simplify S_hv_notallowed slightly by passing a prebuilt message
Nicholas Clark authored
735 "Attempt to access disallowed key '%"SVf"' in"
736 " a restricted hash");
1b1f133 Keep It Simple and Stupid version of readonly hash support.
Nick Ing-Simmons authored
737 }
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
738 if (!(action & (HV_FETCH_LVALUE|HV_FETCH_ISSTORE))) {
739 /* Not doing some form of store, so return failure. */
740 if (flags & HVhek_FREEKEY)
741 Safefree(key);
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
742 return NULL;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
743 }
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
744 if (action & HV_FETCH_LVALUE) {
df5f182 Fix memory leaks in mro_package_moved
Father Chrysostomos authored
745 val = action & HV_FETCH_EMPTY_HE ? NULL : newSV(0);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
746 if (SvMAGICAL(hv)) {
747 /* At this point the old hv_fetch code would call to hv_store,
748 which in turn might do some tied magic. So we need to make that
749 magic check happen. */
750 /* gonna assign to this, so it better be there */
fda2d18 Inline and abolish S_hv_magic_uvar_xkey().
Nicholas Clark authored
751 /* If a fetch-as-store fails on the fetch, then the action is to
752 recurse once into "hv_store". If we didn't do this, then that
753 recursive call would call the key conversion routine again.
754 However, as we replace the original key with the converted
755 key, this would result in a double conversion, which would show
756 up as a bug if the conversion routine is not idempotent. */
d3ba3f5 Make hv_fetch_common() non-static, and change its name to hv_common(),
Nicholas Clark authored
757 return hv_common(hv, keysv, key, klen, flags,
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
758 HV_FETCH_ISSTORE|HV_DISABLE_UVAR_XKEY|return_svp,
759 val, hash);
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
760 /* XXX Surely that could leak if the fetch-was-store fails?
761 Just like the hv_fetch. */
113738b merge hv_fetch and hv_fetch_ent into hv_fetch_common
Nicholas Clark authored
762 }
763 }
764
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
765 /* Welcome to hv_store... */
766
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
767 if (!HvARRAY(hv)) {
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
768 /* Not sure if we can get here. I think the only case of oentry being
769 NULL is for %ENV with dynamic env fetch. But that should disappear
770 with magic in the previous code. */
d58e666 As PERL_HV_ARRAY_ALLOC_BYTES is bytes, not items, the type should be
Nicholas Clark authored
771 char *array;
a02a540 Re: janitorial work ? [patch]
Jim Cromie authored
772 Newxz(array,
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
773 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
d58e666 As PERL_HV_ARRAY_ALLOC_BYTES is bytes, not items, the type should be
Nicholas Clark authored
774 char);
775 HvARRAY(hv) = (HE**)array;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
776 }
777
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
778 oentry = &(HvARRAY(hv))[hash & (I32) xhv->xhv_max];
ab4af70 Tweak the order of initialisation of oentry in hv_fetch_common -
Nicholas Clark authored
779
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
780 entry = new_HE();
781 /* share_hek_flags will do the free for us. This might be considered
782 bad API design. */
783 if (HvSHAREKEYS(hv))
6e838c7 S_share_hek_flags can revert to returning a HEK
Nicholas Clark authored
784 HeKEY_hek(entry) = share_hek_flags(key, klen, hash, flags);
5d2b148 Croak if an attempt is made to modify PL_strtab
Nicholas Clark authored
785 else if (hv == PL_strtab) {
786 /* PL_strtab is usually the only hash without HvSHAREKEYS, so putting
787 this test here is cheap */
788 if (flags & HVhek_FREEKEY)
789 Safefree(key);
790 Perl_croak(aTHX_ S_strtab_error,
791 action & HV_FETCH_LVALUE ? "fetch" : "store");
792 }
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
793 else /* gotta do the real thing */
794 HeKEY_hek(entry) = save_hek_flags(key, klen, hash, flags);
795 HeVAL(entry) = val;
796 HeNEXT(entry) = *oentry;
797 *oentry = entry;
798
799 if (val == &PL_sv_placeholder)
ca73285 Move placeholders into a new rhash magic type.
Nicholas Clark authored
800 HvPLACEHOLDERS(hv)++;
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
801 if (masked_flags & HVhek_ENABLEHVKFLAGS)
802 HvHASKFLAGS_on(hv);
803
0298d7b Avoid updating a variable in a loop.
Nicholas Clark authored
804 {
805 const HE *counter = HeNEXT(entry);
806
4c7185a Correct the macros in the comments in hv.c. Given the improvements in
Nicholas Clark authored
807 xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */
0298d7b Avoid updating a variable in a loop.
Nicholas Clark authored
808 if (!counter) { /* initial entry? */
5ac3629 @iabyn silence some warnings in hv.c
iabyn authored
809 } else if (xhv->xhv_keys > xhv->xhv_max) {
1b95d04 @mfwitten Clean: Actually use HvUSEDKEYS() instead of HvKEYS()
mfwitten authored
810 /* Use only the old HvUSEDKEYS(hv) > HvMAX(hv) condition to limit
5b430b3 @mfwitten Clean: Move old comment to proper location
mfwitten authored
811 bucket splits on a rehashed hash, as we're not going to
812 split it again, and if someone is lucky (evil) enough to
813 get all the keys in one list they could exhaust our memory
814 as we repeatedly double the number of buckets on every
815 entry. Linear search feels a less worse thing to do. */
0298d7b Avoid updating a variable in a loop.
Nicholas Clark authored
816 hsplit(hv);
817 } else if(!HvREHASH(hv)) {
818 U32 n_links = 1;
819
820 while ((counter = HeNEXT(counter)))
821 n_links++;
822
823 if (n_links > HV_MAX_LENGTH_BEFORE_SPLIT) {
824 hsplit(hv);
825 }
826 }
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
827 }
b2c6404 "Space Is a Province of Brazil"
Nicholas Clark authored
828
3c84c86 Move the SV dereference of Perl_hv_fetch()/Perl_hv_store()/
Nicholas Clark authored
829 if (return_svp) {
830 return entry ? (void *) &HeVAL(entry) : NULL;
831 }
832 return (void *) entry;
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
833 }
834
864dbfa initial stub implementation of implicit thread/this
Gurusamy Sarathy authored
835 STATIC void
b0e6ae5 A better fix than 27148
Steve Hay authored
836 S_hv_magic_check(HV *hv, bool *needs_copy, bool *needs_store)
d0066dc Make hv_ functions cope better with 'm'-magic:
Owen Taylor authored
837 {
a3b680e @petdance consting-eleventy.patch: More consts, plus actual bug fix
petdance authored
838 const MAGIC *mg = SvMAGIC(hv);
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
839
840 PERL_ARGS_ASSERT_HV_MAGIC_CHECK;
841
d0066dc Make hv_ functions cope better with 'm'-magic:
Owen Taylor authored
842 *needs_copy = FALSE;
843 *needs_store = TRUE;
844 while (mg) {
845 if (isUPPER(mg->mg_type)) {
846 *needs_copy = TRUE;
d60c5a0 Re: [perl #36733] %SIG not properly local-ized
Rick Delaney authored
847 if (mg->mg_type == PERL_MAGIC_tied) {
d0066dc Make hv_ functions cope better with 'm'-magic:
Owen Taylor authored
848 *needs_store = FALSE;
4ab2a30 @petdance Teeny optimization in S_hv_magic_check
petdance authored
849 return; /* We've set all there is to set. */
d0066dc Make hv_ functions cope better with 'm'-magic:
Owen Taylor authored
850 }
851 }
852 mg = mg->mg_moremagic;
853 }
854 }
855
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
856 /*
a3bcc51 SCALAR/FIRSTKEY for tied hashes in scalar context
Tassilo von Parseval authored
857 =for apidoc hv_scalar
858
859 Evaluates the hash in scalar context and returns the result. Handles magic when the hash is tied.
860
861 =cut
862 */
863
864 SV *
865 Perl_hv_scalar(pTHX_ HV *hv)
866 {
867 SV *sv;
823a54a @petdance More consting, and DRY leads to shrinking object code
petdance authored
868
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
869 PERL_ARGS_ASSERT_HV_SCALAR;
870
823a54a @petdance More consting, and DRY leads to shrinking object code
petdance authored
871 if (SvRMAGICAL(hv)) {
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
872 MAGIC * const mg = mg_find((const SV *)hv, PERL_MAGIC_tied);
823a54a @petdance More consting, and DRY leads to shrinking object code
petdance authored
873 if (mg)
874 return magic_scalarpack(hv, mg);
875 }
a3bcc51 SCALAR/FIRSTKEY for tied hashes in scalar context
Tassilo von Parseval authored
876
877 sv = sv_newmortal();
f4431c5 Replace boolean use of HvFILL(hv) with HvTOTALKEYS(hv), which is equi…
Nicholas Clark authored
878 if (HvTOTALKEYS((const HV *)hv))
a3bcc51 SCALAR/FIRSTKEY for tied hashes in scalar context
Tassilo von Parseval authored
879 Perl_sv_setpvf(aTHX_ sv, "%ld/%ld",
880 (long)HvFILL(hv), (long)HvMAX(hv) + 1);
881 else
882 sv_setiv(sv, 0);
883
884 return sv;
885 }
886
887 /*
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
888 =for apidoc hv_delete
889
a05d6c5 @tonycoz document the behaviour of negative klen for hv_fetch and friends
tonycoz authored
890 Deletes a key/value pair in the hash. The value's SV is removed from
891 the hash, made mortal, and returned to the caller. The absolute
892 value of C<klen> is the length of the key. If C<klen> is negative the
893 key is assumed to be in UTF-8-encoded Unicode. The C<flags> value
894 will normally be zero; if set to G_DISCARD then NULL will be returned.
895 NULL will also be returned if the key is not found.
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
896
897 =for apidoc hv_delete_ent
898
3025a2e @chipdude Document that av_delete and hv_delete make their return values mortal.
chipdude authored
899 Deletes a key/value pair in the hash. The value SV is removed from the hash,
900 made mortal, and returned to the caller. The C<flags> value will normally be
901 zero; if set to G_DISCARD then NULL will be returned. NULL will also be
902 returned if the key is not found. C<hash> can be a valid precomputed hash
903 value, or 0 to ask for it to be computed.
954c199 autogenerate API listing from comments in the source (from Benjamin
Gurusamy Sarathy authored
904
905 =cut
906 */
907
8f8d40a @paulg1973 Refactor VOS patches for bleadperl and perl-5.8.x
paulg1973 authored
908 STATIC SV *
cd6d36a Move the negative key -> utf8 flag conversion out to hv_delete
Nicholas Clark authored
909 S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
910 int k_flags, I32 d_flags, U32 hash)
f1317c8 integrate hv_delete and hv_delete_ent into hv_delete_common
Nicholas Clark authored
911 {
27da23d @jhi Symbian port of Perl
jhi authored
912 dVAR;
eb578fd Omnibus removal of register declarations
Karl Williamson authored
913 XPVHV* xhv;
914 HE *entry;
915 HE **oentry;
9dbc560 Send all delete()/delete_ent() calls via S_hv_fetch_common().
Nicholas Clark authored
916 bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
7a9669c Tweaks to S_hv_delete_common:
Nicholas Clark authored
917 int masked_flags;
1c846c1 Hash lookup of constant strings optimization:
Nick Ing-Simmons authored
918
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
919 if (SvRMAGICAL(hv)) {
0a0bb7c Fix hv_delete for 'm'-magic. Based on following patch, modified
Owen Taylor authored
920 bool needs_copy;
921 bool needs_store;
922 hv_magic_check (hv, &needs_copy, &needs_store);
923
f1317c8 integrate hv_delete and hv_delete_ent into hv_delete_common
Nicholas Clark authored
924 if (needs_copy) {
6136c70 @petdance It's the Barbie bus patch
petdance authored
925 SV *sv;
63c8934 Switch Perl_hv_common() to returning void * rather than HE *.
Nicholas Clark authored
926 entry = (HE *) hv_common(hv, keysv, key, klen,
927 k_flags & ~HVhek_FREEKEY,
928 HV_FETCH_LVALUE|HV_DISABLE_UVAR_XKEY,
929 NULL, hash);
7a9669c Tweaks to S_hv_delete_common:
Nicholas Clark authored
930 sv = entry ? HeVAL(entry) : NULL;
f1317c8 integrate hv_delete and hv_delete_ent into hv_delete_common
Nicholas Clark authored
931 if (sv) {
932 if (SvMAGICAL(sv)) {
933 mg_clear(sv);
934 }
935 if (!needs_store) {
936 if (mg_find(sv, PERL_MAGIC_tiedelem)) {
937 /* No longer an element */
938 sv_unmagic(sv, PERL_MAGIC_tiedelem);
939 return sv;
940 }
a0714e2 Re: [PATCH] s/Null(gv|hv|sv)/NULL/g
Steven Schubiger authored
941 return NULL; /* element cannot be deleted */
f1317c8 integrate hv_delete and hv_delete_ent into hv_delete_common
Nicholas Clark authored
942 }
902173a [win32] Support case-tolerant %ENV
Gurusamy Sarathy authored
943 #ifdef ENV_IS_CASELESS
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
944 else if (mg_find((const SV *)hv, PERL_MAGIC_env)) {
8167a60 Clean up a bug I introduced into caseless ENV hv_delete
Nicholas Clark authored
945 /* XXX This code isn't UTF8 clean. */
59cd0e2 Extend newSVpvn_flags() to also call sv_2mortal() if SVs_TEMP is set in
Nicholas Clark authored
946 keysv = newSVpvn_flags(key, klen, SVs_TEMP);
8167a60 Clean up a bug I introduced into caseless ENV hv_delete
Nicholas Clark authored
947 if (k_flags & HVhek_FREEKEY) {
948 Safefree(key);
949 }
950 key = strupr(SvPVX(keysv));
951 is_utf8 = 0;
952 k_flags = 0;
953 hash = 0;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
954 }
510ac31 @rgs Integrate change #21862 from maint-5.8 :
rgs authored
955 #endif
2fd1c6b [win32] change#398 breaks ENV_IS_CASELESS, fix it
Gurusamy Sarathy authored
956 }
957 }
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
958 }
cbec934 @jhi Revert #10656 for performance reasons but leave in the
jhi authored
959 xhv = (XPVHV*)SvANY(hv);
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
960 if (!HvARRAY(hv))
a0714e2 Re: [PATCH] s/Null(gv|hv|sv)/NULL/g
Steven Schubiger authored
961 return NULL;
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
962
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
963 if (is_utf8) {
c445ea1 @petdance Ho! Ho! Ho! Santa brings consting!
petdance authored
964 const char * const keysave = key;
b464bac @petdance Random consting
petdance authored
965 key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
cd6d36a Move the negative key -> utf8 flag conversion out to hv_delete
Nicholas Clark authored
966
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
967 if (is_utf8)
cd6d36a Move the negative key -> utf8 flag conversion out to hv_delete
Nicholas Clark authored
968 k_flags |= HVhek_UTF8;
969 else
970 k_flags &= ~HVhek_UTF8;
7f66fda Farewell hv_exists_common - exists is now a call to fetch
Nicholas Clark authored
971 if (key != keysave) {
972 if (k_flags & HVhek_FREEKEY) {
973 /* This shouldn't happen if our caller does what we expect,
974 but strictly the API allows it. */
975 Safefree(keysave);
976 }
977 k_flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
978 }
ad64d0e Eliminate (SV *) casts from the rest of *.c, picking up one (further)
Nicholas Clark authored
979 HvHASKFLAGS_on(MUTABLE_SV(hv));
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
980 }
f9a6324 @jhi Patch from Inaba Hiroto:
jhi authored
981
f8d50d9 @iabyn unify PERL_HASH and PERL_HASH_INTERNAL
iabyn authored
982 if (HvREHASH(hv) || (!hash && !(keysv && (SvIsCOW_shared_hash(keysv)))))
983 PERL_HASH_INTERNAL_(hash, key, klen, HvREHASH(hv));
984 else if (!hash)
985 hash = SvSHARED_HASH(keysv);
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
986
7a9669c Tweaks to S_hv_delete_common:
Nicholas Clark authored
987 masked_flags = (k_flags & HVhek_MASK);
988
9de10d5 Eliminate C variables unused since 4d0fbddde6c5dcb9 refactored HvFILL()
Nicholas Clark authored
989 oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)];
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
990 entry = *oentry;
9e720f7 Avoid updating a variable in the loop
Nicholas Clark authored
991 for (; entry; oentry = &HeNEXT(entry), entry = *oentry) {
6136c70 @petdance It's the Barbie bus patch
petdance authored
992 SV *sv;
f3d2f32 Make delete $package::{ISA} work
Father Chrysostomos authored
993 U8 mro_changes = 0; /* 1 = isa; 2 = package moved */
0290c71 Don’t skip mro_package_moved if the parent stash is renamed
Father Chrysostomos authored
994 GV *gv = NULL;
0c3bb3c In S_hv_delete_common, call mro_package_moved after the deletion
Father Chrysostomos authored
995 HV *stash = NULL;
996
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
997 if (HeHASH(entry) != hash) /* strings can't be equal */
998 continue;
eb16046 fixes for all the warnings reported by Visual C (most of this
Gurusamy Sarathy authored
999 if (HeKLEN(entry) != (I32)klen)
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
1000 continue;
1c846c1 Hash lookup of constant strings optimization:
Nick Ing-Simmons authored
1001 if (HeKEY(entry) != key && memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5 perl 5.003_01: hv.c
Perl 5 Porters authored
1002 continue;
7a9669c Tweaks to S_hv_delete_common:
Nicholas Clark authored
1003 if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
c3654f1 @Inaba-Hiroto Additional patch for UTF8-keys (Re: perl@8016)
Inaba-Hiroto authored
1004 continue;
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1005
5d2b148 Croak if an attempt is made to modify PL_strtab
Nicholas Clark authored
1006 if (hv == PL_strtab) {
1007 if (k_flags & HVhek_FREEKEY)
1008 Safefree(key);
1009 Perl_croak(aTHX_ S_strtab_error, "delete");
1010 }
1011
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1012 /* if placeholder is here, it's already been deleted.... */
6136c70 @petdance It's the Barbie bus patch
petdance authored
1013 if (HeVAL(entry) == &PL_sv_placeholder) {
1014 if (k_flags & HVhek_FREEKEY)
1015 Safefree(key);
1016 return NULL;
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1017 }
e5accad Allow COW values to be deleted from restricted hashes
Father Chrysostomos authored
1018 if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))
1019 && !SvIsCOW(HeVAL(entry))) {
d4c19fe @petdance Random accumulated patches
petdance authored
1020 hv_notallowed(k_flags, key, klen,
c8cd646 Simplify S_hv_notallowed slightly by passing a prebuilt message
Nicholas Clark authored
1021 "Attempt to delete readonly key '%"SVf"' from"
1022 " a restricted hash");
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1023 }
b84d086 hv_delete_common was freeing the key, then passing the freed pointer
Nicholas Clark authored
1024 if (k_flags & HVhek_FREEKEY)
1025 Safefree(key);
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1026
3575925 Rename stashes when they move around
Father Chrysostomos authored
1027 /* If this is a stash and the key ends with ::, then someone is
0c3bb3c In S_hv_delete_common, call mro_package_moved after the deletion
Father Chrysostomos authored
1028 * deleting a package.
1029 */
78b79c7 Renaming of stashes should not be visible from Perl
Father Chrysostomos authored
1030 if (HeVAL(entry) && HvENAME_get(hv)) {
0290c71 Don’t skip mro_package_moved if the parent stash is renamed
Father Chrysostomos authored
1031 gv = (GV *)HeVAL(entry);
3575925 Rename stashes when they move around
Father Chrysostomos authored
1032 if (keysv) key = SvPV(keysv, klen);
1f656fc Followup to 088225f/[perl #88132]: packages ending with :
Father Chrysostomos authored
1033 if ((
1034 (klen > 1 && key[klen-2] == ':' && key[klen-1] == ':')
1035 ||
1036 (klen == 1 && key[0] == ':')
1037 )
e0a5239 Fix @ISA recursion during global destruction
Father Chrysostomos authored
1038 && (klen != 6 || hv!=PL_defstash || memNE(key,"main::",6))
0290c71 Don’t skip mro_package_moved if the parent stash is renamed
Father Chrysostomos authored
1039 && SvTYPE(gv) == SVt_PVGV && (stash = GvHV((GV *)gv))
0c3bb3c In S_hv_delete_common, call mro_package_moved after the deletion
Father Chrysostomos authored
1040 && HvENAME_get(stash)) {
0290c71 Don’t skip mro_package_moved if the parent stash is renamed
Father Chrysostomos authored
1041 /* A previous version of this code checked that the
1042 * GV was still in the symbol table by fetching the
1043 * GV with its name. That is not necessary (and
1044 * sometimes incorrect), as HvENAME cannot be set
1045 * on hv if it is not in the symtab. */
f3d2f32 Make delete $package::{ISA} work
Father Chrysostomos authored
1046 mro_changes = 2;
0c3bb3c In S_hv_delete_common, call mro_package_moved after the deletion
Father Chrysostomos authored
1047 /* Hang on to it for a bit. */
1048 SvREFCNT_inc_simple_void_NN(
0290c71 Don’t skip mro_package_moved if the parent stash is renamed
Father Chrysostomos authored
1049 sv_2mortal((SV *)gv)
3575925 Rename stashes when they move around
Father Chrysostomos authored
1050 );
1051 }
f3d2f32 Make delete $package::{ISA} work
Father Chrysostomos authored
1052 else if (klen == 3 && strnEQ(key, "ISA", 3))
1053 mro_changes = 1;
3575925 Rename stashes when they move around
Father Chrysostomos authored
1054 }
1055
8571a3c squash some code in hv.c:S_hv_delete_common
Father Chrysostomos authored
1056 sv = d_flags & G_DISCARD ? HeVAL(entry) : sv_2mortal(HeVAL(entry));
1057 HeVAL(entry) = &PL_sv_placeholder;
5743f2a Update method caches for non-void stash elem deletions
Father Chrysostomos authored
1058 if (sv) {
1059 /* deletion of method from stash */
1060 if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
1061 && HvENAME_get(hv))
1062 mro_method_changed_in(hv);
1063 }
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1064
1065 /*
1066 * If a restricted hash, rather than really deleting the entry, put
1067 * a placeholder there. This marks the key as being "approved", so
1068 * we can still access via not-really-existing key without raising
1069 * an error.
1070 */
f50383f [perl #85026] Deleting the current iterator in void context
Ton Hospel authored
1071 if (SvREADONLY(hv))
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1072 /* We'll be saving this slot, so the number of allocated keys
1073 * doesn't go down, but the number placeholders goes up */
ca73285 Move placeholders into a new rhash magic type.
Nicholas Clark authored
1074 HvPLACEHOLDERS(hv)++;
f50383f [perl #85026] Deleting the current iterator in void context
Ton Hospel authored
1075 else {
a26e96d Fix READONLY hashes:
Nick Ing-Simmons authored
1076 *oentry = HeNEXT(entry);
b79f754 Store the xhv_aux structure after the main array.
Nicholas Clark authored
1077 if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1078 HvLAZYDEL_on(hv);
ae19993 [perl #85026] deleting elements in a HASH iterator
Ton Hospel authored
1079 else {
1080 if (SvOOK(hv) && HvLAZYDEL(hv) &&
1081 entry == HeNEXT(HvAUX(hv)->xhv_eiter))
1082 HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1083 hv_free_ent(hv, entry);
ae19993 [perl #85026] deleting elements in a HASH iterator
Ton Hospel authored
1084 }
4c7185a Correct the macros in the comments in hv.c. Given the improvements in
Nicholas Clark authored
1085 xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
574c802 @jhi If Unicode keys are entered to a hash, a bit is turned on.
jhi authored
1086 if (xhv->xhv_keys == 0)
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
1087 HvHASKFLAGS_off(hv);
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1088 }
0c3bb3c In S_hv_delete_common, call mro_package_moved after the deletion
Father Chrysostomos authored
1089
3b2cd80 [perl #100340] Free hash entries before values on delete
Father Chrysostomos authored
1090 if (d_flags & G_DISCARD) {
1091 SvREFCNT_dec(sv);
1092 sv = NULL;
1093 }
1094
f3d2f32 Make delete $package::{ISA} work
Father Chrysostomos authored
1095 if (mro_changes == 1) mro_isa_changed_in(hv);
1096 else if (mro_changes == 2)
afdbe55 Eliminate the newname param from mro_package_moved
Father Chrysostomos authored
1097 mro_package_moved(NULL, stash, gv, 1);
0c3bb3c In S_hv_delete_common, call mro_package_moved after the deletion
Father Chrysostomos authored
1098
7907280 perl 5.0 alpha 2
Larry Wall authored
1099 return sv;
1100 }
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1101 if (SvREADONLY(hv)) {
d4c19fe @petdance Random accumulated patches
petdance authored
1102 hv_notallowed(k_flags, key, klen,
c8cd646 Simplify S_hv_notallowed slightly by passing a prebuilt message
Nicholas Clark authored
1103 "Attempt to delete disallowed key '%"SVf"' from"
1104 " a restricted hash");
8aacddc Tidied version of Jeffrey Friedl's <jfriedl@yahoo.com> restricted hashes
Nick Ing-Simmons authored
1105 }
1106
19692e8 Re: the dirty half dozen (Re: perl@15662)
Nicholas Clark authored
1107 if (k_flags & HVhek_FREEKEY)
f9a6324 @jhi Patch from Inaba Hiroto:
jhi authored
1108 Safefree(key);
a0714e2 Re: [PATCH] s/Null(gv|hv|sv)/NULL/g
Steven Schubiger authored
1109 return NULL;
7907280 perl 5.0 alpha 2
Larry Wall authored
1110 }
1111
76e3520 [asperl] added AS patch#2
Gurusamy Sarathy authored
1112 STATIC void
cea2e8a more complete support for implicit thread/interpreter pointer,
Gurusamy Sarathy authored
1113 S_hsplit(pTHX_ HV *hv)
7907280 perl 5.0 alpha 2
Larry Wall authored
1114 {
97aff36 @jhi sprinkle dVAR
jhi authored
1115 dVAR;
eb578fd Omnibus removal of register declarations
Karl Williamson authored
1116 XPVHV* const xhv = (XPVHV*)SvANY(hv);
a3b680e @petdance consting-eleventy.patch: More consts, plus actual bug fix
petdance authored
1117 const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
eb578fd Omnibus removal of register declarations
Karl Williamson authored
1118 I32 newsize = oldsize * 2;
1119 I32 i;
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
1120 char *a = (char*) HvARRAY(hv);
eb578fd Omnibus removal of register declarations
Karl Williamson authored
1121 HE **aep;
4b5190b Plan C for foiling the algorithmic complexity attack
Nicholas Clark authored
1122 int longest_chain = 0;
1123 int was_shared;
7907280 perl 5.0 alpha 2
Larry Wall authored
1124
7918f24 assert() that every NN argument is not NULL. Otherwise we have the
Nicholas Clark authored
1125 PERL_ARGS_ASSERT_HSPLIT;
1126
1802629 In hsplit, if a normal hash has placeholders then clear them before
Nicholas Clark authored
1127 /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n",
6c9570d The first three patches from:
Marcus Holland-Moritz authored
1128 (void*)hv, (int) oldsize);*/
1802629 In hsplit, if a normal hash has placeholders then clear them before
Nicholas Clark authored
1129
5d88ecd Various HvPLACEHOLDERS() that should be HvPLACEHOLDERS_get()
Nicholas Clark authored
1130 if (HvPLACEHOLDERS_get(hv) && !SvREADONLY(hv)) {
1802629 In hsplit, if a normal hash has placeholders then clear them before
Nicholas Clark authored
1131 /* Can make this clear any placeholders first for non-restricted hashes,
1132 even though Storable rebuilds restricted hashes by putting in all the
1133 placeholders (first) before turning on the readonly flag, because
1134 Storable always pre-splits the hash. */
1135 hv_clear_placeholders(hv);
1136 }
1137
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored
1138 PL_nomemok = TRUE;
8d6dde3 applied patch, regen headers
Ilya Zakharevich authored
1139 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
b79f754 Store the xhv_aux structure after the main array.
Nicholas Clark authored
1140 Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
1141 + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
422a93e @gisle nomemok
gisle authored
1142 if (!a) {
4a33f86 PL_ for perl's malloc
Nick Ing-Simmons authored
1143 PL_nomemok = FALSE;
422a93e @gisle nomemok
gisle authored
1144 return;
1145 }
b79f754 Store the xhv_aux structure after the main array.
Nicholas Clark authored
1146 if (SvOOK(hv)) {
31f0e52 @vpit Re: blead with -Dusemymalloc fails on t/comp/hints.t
vpit authored
1147 Move(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
b79f754 Store the xhv_aux structure after the main array.
Nicholas Clark authored
1148 }
4633a7c 5.002 beta 1
Larry Wall authored
1149 #else
a02a540 Re: janitorial work ? [patch]
Jim Cromie authored
1150 Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
b79f754 Store the xhv_aux structure after the main array.
Nicholas Clark authored
1151 + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
422a93e @gisle nomemok
gisle authored
1152 if (!a) {
3280af2 PL_ prefix to all perlvars, part1
Nick Ing-Simmons authored
1153 PL_nomemok = FALSE;
422a93e @gisle nomemok
gisle authored
1154 return;
1155 }
7b2c381 Move the xpv_pv/xrv_rv member into the SV head, in a union with
Nicholas Clark authored
1156 Copy(HvARRAY(hv), a, oldsize * sizeof(HE*), char);
b79f754 Store the xhv_aux structure after the main array.
Nicholas Clark authored
1157 if (SvOOK(hv)) {
1158 Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
1159 }
9a87bd0