This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
rudimentary support for remote debugging, from aeons ago (somewhat
[perl5.git] / hv.c
CommitLineData
a0d0e21e 1/* hv.c
79072805 2 *
4eb8286e 3 * Copyright (c) 1991-1999, Larry Wall
79072805
LW
4 *
5 * You may distribute under the terms of either the GNU General Public
6 * License or the Artistic License, as specified in the README file.
7 *
a0d0e21e
LW
8 */
9
10/*
11 * "I sit beside the fire and think of all that I have seen." --Bilbo
79072805
LW
12 */
13
14#include "EXTERN.h"
864dbfa3 15#define PERL_IN_HV_C
79072805
LW
16#include "perl.h"
17
76e3520e 18STATIC HE*
cea2e8a9 19S_new_he(pTHX)
4633a7c4
LW
20{
21 HE* he;
333f433b
DG
22 LOCK_SV_MUTEX;
23 if (!PL_he_root)
24 more_he();
25 he = PL_he_root;
26 PL_he_root = HeNEXT(he);
27 UNLOCK_SV_MUTEX;
28 return he;
4633a7c4
LW
29}
30
76e3520e 31STATIC void
cea2e8a9 32S_del_he(pTHX_ HE *p)
4633a7c4 33{
333f433b 34 LOCK_SV_MUTEX;
3280af22
NIS
35 HeNEXT(p) = (HE*)PL_he_root;
36 PL_he_root = p;
333f433b 37 UNLOCK_SV_MUTEX;
4633a7c4
LW
38}
39
333f433b 40STATIC void
cea2e8a9 41S_more_he(pTHX)
4633a7c4
LW
42{
43 register HE* he;
44 register HE* heend;
3280af22
NIS
45 New(54, PL_he_root, 1008/sizeof(HE), HE);
46 he = PL_he_root;
4633a7c4
LW
47 heend = &he[1008 / sizeof(HE) - 1];
48 while (he < heend) {
fde52b5c 49 HeNEXT(he) = (HE*)(he + 1);
4633a7c4
LW
50 he++;
51 }
fde52b5c 52 HeNEXT(he) = 0;
4633a7c4
LW
53}
54
76e3520e 55STATIC HEK *
cea2e8a9 56S_save_hek(pTHX_ const char *str, I32 len, U32 hash)
bbce6d69
PP
57{
58 char *k;
59 register HEK *hek;
60
ff68c719 61 New(54, k, HEK_BASESIZE + len + 1, char);
bbce6d69 62 hek = (HEK*)k;
ff68c719
PP
63 Copy(str, HEK_KEY(hek), len, char);
64 *(HEK_KEY(hek) + len) = '\0';
65 HEK_LEN(hek) = len;
66 HEK_HASH(hek) = hash;
bbce6d69
PP
67 return hek;
68}
69
70void
864dbfa3 71Perl_unshare_hek(pTHX_ HEK *hek)
bbce6d69 72{
ff68c719 73 unsharepvn(HEK_KEY(hek),HEK_LEN(hek),HEK_HASH(hek));
bbce6d69
PP
74}
75
d18c6117
GS
76#if defined(USE_ITHREADS)
77HE *
78Perl_he_dup(pTHX_ HE *e, bool shared)
79{
80 HE *ret;
81
82 if (!e)
83 return Nullhe;
84 ret = new_he();
85 HeNEXT(ret) = (HE*)NULL;
86 if (HeKLEN(e) == HEf_SVKEY)
87 HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e)));
88 else if (shared)
89 HeKEY_hek(ret) = share_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
90 else
91 HeKEY_hek(ret) = save_hek(HeKEY(e), HeKLEN(e), HeHASH(e));
92 HeVAL(ret) = SvREFCNT_inc(sv_dup(HeVAL(e)));
93 return ret;
94}
95#endif /* USE_ITHREADS */
96
fde52b5c
PP
97/* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
98 * contains an SV* */
99
79072805 100SV**
864dbfa3 101Perl_hv_fetch(pTHX_ HV *hv, const char *key, U32 klen, I32 lval)
79072805
LW
102{
103 register XPVHV* xhv;
fde52b5c 104 register U32 hash;
79072805 105 register HE *entry;
79072805 106 SV *sv;
79072805
LW
107
108 if (!hv)
109 return 0;
463ee0b2 110
8990e307 111 if (SvRMAGICAL(hv)) {
463ee0b2 112 if (mg_find((SV*)hv,'P')) {
11343788 113 dTHR;
8990e307 114 sv = sv_newmortal();
463ee0b2 115 mg_copy((SV*)hv, sv, key, klen);
3280af22
NIS
116 PL_hv_fetch_sv = sv;
117 return &PL_hv_fetch_sv;
463ee0b2 118 }
902173a3
GS
119#ifdef ENV_IS_CASELESS
120 else if (mg_find((SV*)hv,'E')) {
e7152ba2
GS
121 U32 i;
122 for (i = 0; i < klen; ++i)
123 if (isLOWER(key[i])) {
79cb57f6 124 char *nkey = strupr(SvPVX(sv_2mortal(newSVpvn(key,klen))));
e7152ba2
GS
125 SV **ret = hv_fetch(hv, nkey, klen, 0);
126 if (!ret && lval)
127 ret = hv_store(hv, key, klen, NEWSV(61,0), 0);
128 return ret;
129 }
902173a3
GS
130 }
131#endif
463ee0b2
LW
132 }
133
79072805
LW
134 xhv = (XPVHV*)SvANY(hv);
135 if (!xhv->xhv_array) {
a0d0e21e
LW
136 if (lval
137#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
138 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
139#endif
140 )
d18c6117
GS
141 Newz(503, xhv->xhv_array,
142 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
79072805
LW
143 else
144 return 0;
145 }
146
fde52b5c 147 PERL_HASH(hash, key, klen);
79072805 148
a0d0e21e 149 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
fde52b5c
PP
150 for (; entry; entry = HeNEXT(entry)) {
151 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 152 continue;
fde52b5c 153 if (HeKLEN(entry) != klen)
79072805 154 continue;
36477c24 155 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 156 continue;
fde52b5c 157 return &HeVAL(entry);
79072805 158 }
a0d0e21e
LW
159#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
160 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
a6c40364
GS
161 unsigned long len;
162 char *env = PerlEnv_ENVgetenv_len(key,&len);
163 if (env) {
164 sv = newSVpvn(env,len);
165 SvTAINTED_on(sv);
166 return hv_store(hv,key,klen,sv,hash);
167 }
a0d0e21e
LW
168 }
169#endif
79072805
LW
170 if (lval) { /* gonna assign to this, so it better be there */
171 sv = NEWSV(61,0);
e7152ba2 172 return hv_store(hv,key,klen,sv,hash);
79072805
LW
173 }
174 return 0;
175}
176
fde52b5c
PP
177/* returns a HE * structure with the all fields set */
178/* note that hent_val will be a mortal sv for MAGICAL hashes */
179HE *
864dbfa3 180Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
fde52b5c
PP
181{
182 register XPVHV* xhv;
183 register char *key;
184 STRLEN klen;
185 register HE *entry;
186 SV *sv;
187
188 if (!hv)
189 return 0;
190
902173a3
GS
191 if (SvRMAGICAL(hv)) {
192 if (mg_find((SV*)hv,'P')) {
6ff68fdd 193 dTHR;
902173a3
GS
194 sv = sv_newmortal();
195 keysv = sv_2mortal(newSVsv(keysv));
196 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
3280af22 197 if (!HeKEY_hek(&PL_hv_fetch_ent_mh)) {
902173a3
GS
198 char *k;
199 New(54, k, HEK_BASESIZE + sizeof(SV*), char);
3280af22 200 HeKEY_hek(&PL_hv_fetch_ent_mh) = (HEK*)k;
902173a3 201 }
3280af22
NIS
202 HeSVKEY_set(&PL_hv_fetch_ent_mh, keysv);
203 HeVAL(&PL_hv_fetch_ent_mh) = sv;
204 return &PL_hv_fetch_ent_mh;
1cf368ac 205 }
902173a3
GS
206#ifdef ENV_IS_CASELESS
207 else if (mg_find((SV*)hv,'E')) {
e7152ba2 208 U32 i;
902173a3 209 key = SvPV(keysv, klen);
e7152ba2
GS
210 for (i = 0; i < klen; ++i)
211 if (isLOWER(key[i])) {
79cb57f6 212 SV *nkeysv = sv_2mortal(newSVpvn(key,klen));
e7152ba2
GS
213 (void)strupr(SvPVX(nkeysv));
214 entry = hv_fetch_ent(hv, nkeysv, 0, 0);
215 if (!entry && lval)
216 entry = hv_store_ent(hv, keysv, NEWSV(61,0), hash);
217 return entry;
218 }
902173a3
GS
219 }
220#endif
fde52b5c
PP
221 }
222
effa1e2d 223 xhv = (XPVHV*)SvANY(hv);
fde52b5c
PP
224 if (!xhv->xhv_array) {
225 if (lval
226#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
227 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
228#endif
229 )
d18c6117
GS
230 Newz(503, xhv->xhv_array,
231 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
fde52b5c
PP
232 else
233 return 0;
234 }
235
effa1e2d
PP
236 key = SvPV(keysv, klen);
237
238 if (!hash)
239 PERL_HASH(hash, key, klen);
240
fde52b5c
PP
241 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
242 for (; entry; entry = HeNEXT(entry)) {
243 if (HeHASH(entry) != hash) /* strings can't be equal */
244 continue;
245 if (HeKLEN(entry) != klen)
246 continue;
36477c24 247 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
248 continue;
249 return entry;
250 }
251#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
252 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
a6c40364
GS
253 unsigned long len;
254 char *env = PerlEnv_ENVgetenv_len(key,&len);
255 if (env) {
256 sv = newSVpvn(env,len);
257 SvTAINTED_on(sv);
258 return hv_store_ent(hv,keysv,sv,hash);
259 }
fde52b5c
PP
260 }
261#endif
262 if (lval) { /* gonna assign to this, so it better be there */
263 sv = NEWSV(61,0);
e7152ba2 264 return hv_store_ent(hv,keysv,sv,hash);
fde52b5c
PP
265 }
266 return 0;
267}
268
864dbfa3 269STATIC void
cea2e8a9 270S_hv_magic_check(pTHX_ HV *hv, bool *needs_copy, bool *needs_store)
d0066dc7
OT
271{
272 MAGIC *mg = SvMAGIC(hv);
273 *needs_copy = FALSE;
274 *needs_store = TRUE;
275 while (mg) {
276 if (isUPPER(mg->mg_type)) {
277 *needs_copy = TRUE;
278 switch (mg->mg_type) {
279 case 'P':
d0066dc7
OT
280 case 'S':
281 *needs_store = FALSE;
d0066dc7
OT
282 }
283 }
284 mg = mg->mg_moremagic;
285 }
286}
287
79072805 288SV**
864dbfa3 289Perl_hv_store(pTHX_ HV *hv, const char *key, U32 klen, SV *val, register U32 hash)
79072805
LW
290{
291 register XPVHV* xhv;
79072805
LW
292 register I32 i;
293 register HE *entry;
294 register HE **oentry;
79072805
LW
295
296 if (!hv)
297 return 0;
298
299 xhv = (XPVHV*)SvANY(hv);
463ee0b2 300 if (SvMAGICAL(hv)) {
d0066dc7
OT
301 bool needs_copy;
302 bool needs_store;
303 hv_magic_check (hv, &needs_copy, &needs_store);
304 if (needs_copy) {
305 mg_copy((SV*)hv, val, key, klen);
306 if (!xhv->xhv_array && !needs_store)
307 return 0;
902173a3
GS
308#ifdef ENV_IS_CASELESS
309 else if (mg_find((SV*)hv,'E')) {
79cb57f6 310 SV *sv = sv_2mortal(newSVpvn(key,klen));
902173a3
GS
311 key = strupr(SvPVX(sv));
312 hash = 0;
313 }
314#endif
d0066dc7 315 }
463ee0b2 316 }
fde52b5c
PP
317 if (!hash)
318 PERL_HASH(hash, key, klen);
319
320 if (!xhv->xhv_array)
d18c6117
GS
321 Newz(505, xhv->xhv_array,
322 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
fde52b5c
PP
323
324 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
325 i = 1;
326
327 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
328 if (HeHASH(entry) != hash) /* strings can't be equal */
329 continue;
330 if (HeKLEN(entry) != klen)
331 continue;
36477c24 332 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
333 continue;
334 SvREFCNT_dec(HeVAL(entry));
335 HeVAL(entry) = val;
336 return &HeVAL(entry);
337 }
338
339 entry = new_he();
fde52b5c 340 if (HvSHAREKEYS(hv))
ff68c719 341 HeKEY_hek(entry) = share_hek(key, klen, hash);
fde52b5c 342 else /* gotta do the real thing */
ff68c719 343 HeKEY_hek(entry) = save_hek(key, klen, hash);
fde52b5c 344 HeVAL(entry) = val;
fde52b5c
PP
345 HeNEXT(entry) = *oentry;
346 *oentry = entry;
347
348 xhv->xhv_keys++;
349 if (i) { /* initial entry? */
350 ++xhv->xhv_fill;
351 if (xhv->xhv_keys > xhv->xhv_max)
352 hsplit(hv);
79072805
LW
353 }
354
fde52b5c
PP
355 return &HeVAL(entry);
356}
357
358HE *
864dbfa3 359Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, register U32 hash)
fde52b5c
PP
360{
361 register XPVHV* xhv;
362 register char *key;
363 STRLEN klen;
364 register I32 i;
365 register HE *entry;
366 register HE **oentry;
367
368 if (!hv)
369 return 0;
370
371 xhv = (XPVHV*)SvANY(hv);
372 if (SvMAGICAL(hv)) {
aeea060c 373 dTHR;
d0066dc7
OT
374 bool needs_copy;
375 bool needs_store;
376 hv_magic_check (hv, &needs_copy, &needs_store);
377 if (needs_copy) {
3280af22
NIS
378 bool save_taint = PL_tainted;
379 if (PL_tainting)
380 PL_tainted = SvTAINTED(keysv);
d0066dc7
OT
381 keysv = sv_2mortal(newSVsv(keysv));
382 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
383 TAINT_IF(save_taint);
384 if (!xhv->xhv_array && !needs_store)
385 return Nullhe;
902173a3
GS
386#ifdef ENV_IS_CASELESS
387 else if (mg_find((SV*)hv,'E')) {
388 key = SvPV(keysv, klen);
79cb57f6 389 keysv = sv_2mortal(newSVpvn(key,klen));
902173a3
GS
390 (void)strupr(SvPVX(keysv));
391 hash = 0;
392 }
393#endif
394 }
fde52b5c
PP
395 }
396
397 key = SvPV(keysv, klen);
902173a3 398
fde52b5c
PP
399 if (!hash)
400 PERL_HASH(hash, key, klen);
401
79072805 402 if (!xhv->xhv_array)
d18c6117
GS
403 Newz(505, xhv->xhv_array,
404 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
79072805 405
a0d0e21e 406 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
407 i = 1;
408
fde52b5c
PP
409 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
410 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 411 continue;
fde52b5c 412 if (HeKLEN(entry) != klen)
79072805 413 continue;
36477c24 414 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 415 continue;
fde52b5c
PP
416 SvREFCNT_dec(HeVAL(entry));
417 HeVAL(entry) = val;
418 return entry;
79072805 419 }
79072805 420
4633a7c4 421 entry = new_he();
fde52b5c 422 if (HvSHAREKEYS(hv))
ff68c719 423 HeKEY_hek(entry) = share_hek(key, klen, hash);
fde52b5c 424 else /* gotta do the real thing */
ff68c719 425 HeKEY_hek(entry) = save_hek(key, klen, hash);
fde52b5c 426 HeVAL(entry) = val;
fde52b5c 427 HeNEXT(entry) = *oentry;
79072805
LW
428 *oentry = entry;
429
463ee0b2 430 xhv->xhv_keys++;
79072805 431 if (i) { /* initial entry? */
463ee0b2
LW
432 ++xhv->xhv_fill;
433 if (xhv->xhv_keys > xhv->xhv_max)
79072805
LW
434 hsplit(hv);
435 }
79072805 436
fde52b5c 437 return entry;
79072805
LW
438}
439
440SV *
864dbfa3 441Perl_hv_delete(pTHX_ HV *hv, const char *key, U32 klen, I32 flags)
79072805
LW
442{
443 register XPVHV* xhv;
79072805 444 register I32 i;
fde52b5c 445 register U32 hash;
79072805
LW
446 register HE *entry;
447 register HE **oentry;
67a38de0 448 SV **svp;
79072805 449 SV *sv;
79072805
LW
450
451 if (!hv)
452 return Nullsv;
8990e307 453 if (SvRMAGICAL(hv)) {
0a0bb7c7
OT
454 bool needs_copy;
455 bool needs_store;
456 hv_magic_check (hv, &needs_copy, &needs_store);
457
67a38de0
NIS
458 if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
459 sv = *svp;
0a0bb7c7
OT
460 mg_clear(sv);
461 if (!needs_store) {
462 if (mg_find(sv, 'p')) {
463 sv_unmagic(sv, 'p'); /* No longer an element */
464 return sv;
465 }
466 return Nullsv; /* element cannot be deleted */
467 }
902173a3 468#ifdef ENV_IS_CASELESS
2fd1c6b8 469 else if (mg_find((SV*)hv,'E')) {
79cb57f6 470 sv = sv_2mortal(newSVpvn(key,klen));
2fd1c6b8
GS
471 key = strupr(SvPVX(sv));
472 }
902173a3 473#endif
2fd1c6b8 474 }
463ee0b2 475 }
79072805
LW
476 xhv = (XPVHV*)SvANY(hv);
477 if (!xhv->xhv_array)
478 return Nullsv;
fde52b5c
PP
479
480 PERL_HASH(hash, key, klen);
79072805 481
a0d0e21e 482 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
483 entry = *oentry;
484 i = 1;
fde52b5c
PP
485 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
486 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 487 continue;
fde52b5c 488 if (HeKLEN(entry) != klen)
79072805 489 continue;
36477c24 490 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
79072805 491 continue;
fde52b5c 492 *oentry = HeNEXT(entry);
79072805
LW
493 if (i && !*oentry)
494 xhv->xhv_fill--;
748a9306
LW
495 if (flags & G_DISCARD)
496 sv = Nullsv;
497 else
fde52b5c 498 sv = sv_mortalcopy(HeVAL(entry));
a0d0e21e 499 if (entry == xhv->xhv_eiter)
72940dca 500 HvLAZYDEL_on(hv);
a0d0e21e 501 else
68dc0745 502 hv_free_ent(hv, entry);
fde52b5c
PP
503 --xhv->xhv_keys;
504 return sv;
505 }
506 return Nullsv;
507}
508
509SV *
864dbfa3 510Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
fde52b5c
PP
511{
512 register XPVHV* xhv;
513 register I32 i;
514 register char *key;
515 STRLEN klen;
516 register HE *entry;
517 register HE **oentry;
518 SV *sv;
519
520 if (!hv)
521 return Nullsv;
522 if (SvRMAGICAL(hv)) {
0a0bb7c7
OT
523 bool needs_copy;
524 bool needs_store;
525 hv_magic_check (hv, &needs_copy, &needs_store);
526
67a38de0 527 if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
0a0bb7c7
OT
528 sv = HeVAL(entry);
529 mg_clear(sv);
530 if (!needs_store) {
531 if (mg_find(sv, 'p')) {
532 sv_unmagic(sv, 'p'); /* No longer an element */
533 return sv;
534 }
535 return Nullsv; /* element cannot be deleted */
536 }
902173a3 537#ifdef ENV_IS_CASELESS
2fd1c6b8
GS
538 else if (mg_find((SV*)hv,'E')) {
539 key = SvPV(keysv, klen);
79cb57f6 540 keysv = sv_2mortal(newSVpvn(key,klen));
2fd1c6b8
GS
541 (void)strupr(SvPVX(keysv));
542 hash = 0;
543 }
902173a3 544#endif
2fd1c6b8 545 }
fde52b5c
PP
546 }
547 xhv = (XPVHV*)SvANY(hv);
548 if (!xhv->xhv_array)
549 return Nullsv;
550
551 key = SvPV(keysv, klen);
552
553 if (!hash)
554 PERL_HASH(hash, key, klen);
555
556 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
557 entry = *oentry;
558 i = 1;
559 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
560 if (HeHASH(entry) != hash) /* strings can't be equal */
561 continue;
562 if (HeKLEN(entry) != klen)
563 continue;
36477c24 564 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
565 continue;
566 *oentry = HeNEXT(entry);
567 if (i && !*oentry)
568 xhv->xhv_fill--;
569 if (flags & G_DISCARD)
570 sv = Nullsv;
571 else
572 sv = sv_mortalcopy(HeVAL(entry));
573 if (entry == xhv->xhv_eiter)
72940dca 574 HvLAZYDEL_on(hv);
fde52b5c 575 else
68dc0745 576 hv_free_ent(hv, entry);
463ee0b2 577 --xhv->xhv_keys;
79072805
LW
578 return sv;
579 }
79072805 580 return Nullsv;
79072805
LW
581}
582
a0d0e21e 583bool
864dbfa3 584Perl_hv_exists(pTHX_ HV *hv, const char *key, U32 klen)
a0d0e21e
LW
585{
586 register XPVHV* xhv;
fde52b5c 587 register U32 hash;
a0d0e21e
LW
588 register HE *entry;
589 SV *sv;
590
591 if (!hv)
592 return 0;
593
594 if (SvRMAGICAL(hv)) {
595 if (mg_find((SV*)hv,'P')) {
11343788 596 dTHR;
a0d0e21e
LW
597 sv = sv_newmortal();
598 mg_copy((SV*)hv, sv, key, klen);
599 magic_existspack(sv, mg_find(sv, 'p'));
600 return SvTRUE(sv);
601 }
902173a3
GS
602#ifdef ENV_IS_CASELESS
603 else if (mg_find((SV*)hv,'E')) {
79cb57f6 604 sv = sv_2mortal(newSVpvn(key,klen));
902173a3
GS
605 key = strupr(SvPVX(sv));
606 }
607#endif
a0d0e21e
LW
608 }
609
610 xhv = (XPVHV*)SvANY(hv);
f675dbe5 611#ifndef DYNAMIC_ENV_FETCH
a0d0e21e
LW
612 if (!xhv->xhv_array)
613 return 0;
f675dbe5 614#endif
a0d0e21e 615
fde52b5c 616 PERL_HASH(hash, key, klen);
a0d0e21e 617
f675dbe5
CB
618#ifdef DYNAMIC_ENV_FETCH
619 if (!xhv->xhv_array) entry = Null(HE*);
620 else
621#endif
a0d0e21e 622 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
fde52b5c
PP
623 for (; entry; entry = HeNEXT(entry)) {
624 if (HeHASH(entry) != hash) /* strings can't be equal */
a0d0e21e 625 continue;
fde52b5c 626 if (HeKLEN(entry) != klen)
a0d0e21e 627 continue;
36477c24 628 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
629 continue;
630 return TRUE;
631 }
f675dbe5 632#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
a6c40364
GS
633 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
634 unsigned long len;
635 char *env = PerlEnv_ENVgetenv_len(key,&len);
636 if (env) {
637 sv = newSVpvn(env,len);
638 SvTAINTED_on(sv);
639 (void)hv_store(hv,key,klen,sv,hash);
640 return TRUE;
641 }
f675dbe5
CB
642 }
643#endif
fde52b5c
PP
644 return FALSE;
645}
646
647
648bool
864dbfa3 649Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
fde52b5c
PP
650{
651 register XPVHV* xhv;
652 register char *key;
653 STRLEN klen;
654 register HE *entry;
655 SV *sv;
656
657 if (!hv)
658 return 0;
659
660 if (SvRMAGICAL(hv)) {
661 if (mg_find((SV*)hv,'P')) {
e858de61 662 dTHR; /* just for SvTRUE */
fde52b5c 663 sv = sv_newmortal();
effa1e2d 664 keysv = sv_2mortal(newSVsv(keysv));
fde52b5c
PP
665 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
666 magic_existspack(sv, mg_find(sv, 'p'));
667 return SvTRUE(sv);
668 }
902173a3
GS
669#ifdef ENV_IS_CASELESS
670 else if (mg_find((SV*)hv,'E')) {
671 key = SvPV(keysv, klen);
79cb57f6 672 keysv = sv_2mortal(newSVpvn(key,klen));
902173a3
GS
673 (void)strupr(SvPVX(keysv));
674 hash = 0;
675 }
676#endif
fde52b5c
PP
677 }
678
679 xhv = (XPVHV*)SvANY(hv);
f675dbe5 680#ifndef DYNAMIC_ENV_FETCH
fde52b5c
PP
681 if (!xhv->xhv_array)
682 return 0;
f675dbe5 683#endif
fde52b5c
PP
684
685 key = SvPV(keysv, klen);
686 if (!hash)
687 PERL_HASH(hash, key, klen);
688
f675dbe5
CB
689#ifdef DYNAMIC_ENV_FETCH
690 if (!xhv->xhv_array) entry = Null(HE*);
691 else
692#endif
fde52b5c
PP
693 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
694 for (; entry; entry = HeNEXT(entry)) {
695 if (HeHASH(entry) != hash) /* strings can't be equal */
696 continue;
697 if (HeKLEN(entry) != klen)
698 continue;
36477c24 699 if (memNE(HeKEY(entry),key,klen)) /* is this it? */
a0d0e21e
LW
700 continue;
701 return TRUE;
702 }
f675dbe5 703#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
a6c40364
GS
704 if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME)) {
705 unsigned long len;
706 char *env = PerlEnv_ENVgetenv_len(key,&len);
707 if (env) {
708 sv = newSVpvn(env,len);
709 SvTAINTED_on(sv);
710 (void)hv_store_ent(hv,keysv,sv,hash);
711 return TRUE;
712 }
f675dbe5
CB
713 }
714#endif
a0d0e21e
LW
715 return FALSE;
716}
717
76e3520e 718STATIC void
cea2e8a9 719S_hsplit(pTHX_ HV *hv)
79072805
LW
720{
721 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e 722 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
79072805
LW
723 register I32 newsize = oldsize * 2;
724 register I32 i;
72311751
GS
725 register char *a = xhv->xhv_array;
726 register HE **aep;
727 register HE **bep;
79072805
LW
728 register HE *entry;
729 register HE **oentry;
730
3280af22 731 PL_nomemok = TRUE;
8d6dde3e 732#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
d18c6117 733 Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 734 if (!a) {
4a33f861 735 PL_nomemok = FALSE;
422a93e5
GA
736 return;
737 }
4633a7c4 738#else
4633a7c4 739#define MALLOC_OVERHEAD 16
d18c6117 740 New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 741 if (!a) {
3280af22 742 PL_nomemok = FALSE;
422a93e5
GA
743 return;
744 }
72311751 745 Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
fba3b22e 746 if (oldsize >= 64) {
d18c6117 747 offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
4633a7c4
LW
748 }
749 else
750 Safefree(xhv->xhv_array);
751#endif
752
3280af22 753 PL_nomemok = FALSE;
72311751 754 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
79072805 755 xhv->xhv_max = --newsize;
72311751
GS
756 xhv->xhv_array = a;
757 aep = (HE**)a;
79072805 758
72311751
GS
759 for (i=0; i<oldsize; i++,aep++) {
760 if (!*aep) /* non-existent */
79072805 761 continue;
72311751
GS
762 bep = aep+oldsize;
763 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
fde52b5c
PP
764 if ((HeHASH(entry) & newsize) != i) {
765 *oentry = HeNEXT(entry);
72311751
GS
766 HeNEXT(entry) = *bep;
767 if (!*bep)
79072805 768 xhv->xhv_fill++;
72311751 769 *bep = entry;
79072805
LW
770 continue;
771 }
772 else
fde52b5c 773 oentry = &HeNEXT(entry);
79072805 774 }
72311751 775 if (!*aep) /* everything moved */
79072805
LW
776 xhv->xhv_fill--;
777 }
778}
779
72940dca 780void
864dbfa3 781Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
72940dca
PP
782{
783 register XPVHV* xhv = (XPVHV*)SvANY(hv);
784 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
785 register I32 newsize;
786 register I32 i;
787 register I32 j;
72311751
GS
788 register char *a;
789 register HE **aep;
72940dca
PP
790 register HE *entry;
791 register HE **oentry;
792
793 newsize = (I32) newmax; /* possible truncation here */
794 if (newsize != newmax || newmax <= oldsize)
795 return;
796 while ((newsize & (1 + ~newsize)) != newsize) {
797 newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
798 }
799 if (newsize < newmax)
800 newsize *= 2;
801 if (newsize < newmax)
802 return; /* overflow detection */
803
72311751 804 a = xhv->xhv_array;
72940dca 805 if (a) {
3280af22 806 PL_nomemok = TRUE;
8d6dde3e 807#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
d18c6117 808 Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 809 if (!a) {
4a33f861 810 PL_nomemok = FALSE;
422a93e5
GA
811 return;
812 }
72940dca 813#else
d18c6117 814 New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
422a93e5 815 if (!a) {
3280af22 816 PL_nomemok = FALSE;
422a93e5
GA
817 return;
818 }
72311751 819 Copy(xhv->xhv_array, a, oldsize * sizeof(HE*), char);
fba3b22e 820 if (oldsize >= 64) {
d18c6117 821 offer_nice_chunk(xhv->xhv_array, PERL_HV_ARRAY_ALLOC_BYTES(oldsize));
72940dca
PP
822 }
823 else
824 Safefree(xhv->xhv_array);
825#endif
3280af22 826 PL_nomemok = FALSE;
72311751 827 Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
72940dca
PP
828 }
829 else {
d18c6117 830 Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
72940dca
PP
831 }
832 xhv->xhv_max = --newsize;
72311751 833 xhv->xhv_array = a;
72940dca
PP
834 if (!xhv->xhv_fill) /* skip rest if no entries */
835 return;
836
72311751
GS
837 aep = (HE**)a;
838 for (i=0; i<oldsize; i++,aep++) {
839 if (!*aep) /* non-existent */
72940dca 840 continue;
72311751 841 for (oentry = aep, entry = *aep; entry; entry = *oentry) {
72940dca
PP
842 if ((j = (HeHASH(entry) & newsize)) != i) {
843 j -= i;
844 *oentry = HeNEXT(entry);
72311751 845 if (!(HeNEXT(entry) = aep[j]))
72940dca 846 xhv->xhv_fill++;
72311751 847 aep[j] = entry;
72940dca
PP
848 continue;
849 }
850 else
851 oentry = &HeNEXT(entry);
852 }
72311751 853 if (!*aep) /* everything moved */
72940dca
PP
854 xhv->xhv_fill--;
855 }
856}
857
79072805 858HV *
864dbfa3 859Perl_newHV(pTHX)
79072805
LW
860{
861 register HV *hv;
862 register XPVHV* xhv;
863
a0d0e21e
LW
864 hv = (HV*)NEWSV(502,0);
865 sv_upgrade((SV *)hv, SVt_PVHV);
79072805
LW
866 xhv = (XPVHV*)SvANY(hv);
867 SvPOK_off(hv);
868 SvNOK_off(hv);
fde52b5c
PP
869#ifndef NODEFAULT_SHAREKEYS
870 HvSHAREKEYS_on(hv); /* key-sharing on by default */
871#endif
463ee0b2 872 xhv->xhv_max = 7; /* start with 8 buckets */
79072805
LW
873 xhv->xhv_fill = 0;
874 xhv->xhv_pmroot = 0;
79072805
LW
875 (void)hv_iterinit(hv); /* so each() will start off right */
876 return hv;
877}
878
b3ac6de7 879HV *
864dbfa3 880Perl_newHVhv(pTHX_ HV *ohv)
b3ac6de7
IZ
881{
882 register HV *hv;
b3ac6de7
IZ
883 STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
884 STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
885
886 hv = newHV();
887 while (hv_max && hv_max + 1 >= hv_fill * 2)
888 hv_max = hv_max / 2; /* Is always 2^n-1 */
4a76a316 889 HvMAX(hv) = hv_max;
b3ac6de7
IZ
890 if (!hv_fill)
891 return hv;
892
893#if 0
33c27489 894 if (! SvTIED_mg((SV*)ohv, 'P')) {
b3ac6de7
IZ
895 /* Quick way ???*/
896 }
897 else
898#endif
899 {
900 HE *entry;
901 I32 hv_riter = HvRITER(ohv); /* current root of iterator */
902 HE *hv_eiter = HvEITER(ohv); /* current entry of iterator */
903
904 /* Slow way */
4a76a316 905 hv_iterinit(ohv);
b3ac6de7
IZ
906 while (entry = hv_iternext(ohv)) {
907 hv_store(hv, HeKEY(entry), HeKLEN(entry),
908 SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
909 }
910 HvRITER(ohv) = hv_riter;
911 HvEITER(ohv) = hv_eiter;
912 }
913
914 return hv;
915}
916
79072805 917void
864dbfa3 918Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
79072805 919{
16bdeea2
GS
920 SV *val;
921
68dc0745 922 if (!entry)
79072805 923 return;
16bdeea2 924 val = HeVAL(entry);
257c9e5b 925 if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
3280af22 926 PL_sub_generation++; /* may be deletion of method from stash */
16bdeea2 927 SvREFCNT_dec(val);
68dc0745
PP
928 if (HeKLEN(entry) == HEf_SVKEY) {
929 SvREFCNT_dec(HeKEY_sv(entry));
930 Safefree(HeKEY_hek(entry));
44a8e56a
PP
931 }
932 else if (HvSHAREKEYS(hv))
68dc0745 933 unshare_hek(HeKEY_hek(entry));
fde52b5c 934 else
68dc0745
PP
935 Safefree(HeKEY_hek(entry));
936 del_he(entry);
79072805
LW
937}
938
939void
864dbfa3 940Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
79072805 941{
68dc0745 942 if (!entry)
79072805 943 return;
68dc0745 944 if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
3280af22 945 PL_sub_generation++; /* may be deletion of method from stash */
68dc0745
PP
946 sv_2mortal(HeVAL(entry)); /* free between statements */
947 if (HeKLEN(entry) == HEf_SVKEY) {
948 sv_2mortal(HeKEY_sv(entry));
949 Safefree(HeKEY_hek(entry));
44a8e56a
PP
950 }
951 else if (HvSHAREKEYS(hv))
68dc0745 952 unshare_hek(HeKEY_hek(entry));
fde52b5c 953 else
68dc0745
PP
954 Safefree(HeKEY_hek(entry));
955 del_he(entry);
79072805
LW
956}
957
958void
864dbfa3 959Perl_hv_clear(pTHX_ HV *hv)
79072805
LW
960{
961 register XPVHV* xhv;
962 if (!hv)
963 return;
964 xhv = (XPVHV*)SvANY(hv);
463ee0b2 965 hfreeentries(hv);
79072805 966 xhv->xhv_fill = 0;
a0d0e21e 967 xhv->xhv_keys = 0;
79072805 968 if (xhv->xhv_array)
463ee0b2 969 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
a0d0e21e
LW
970
971 if (SvRMAGICAL(hv))
972 mg_clear((SV*)hv);
79072805
LW
973}
974
76e3520e 975STATIC void
cea2e8a9 976S_hfreeentries(pTHX_ HV *hv)
79072805 977{
a0d0e21e 978 register HE **array;
68dc0745
PP
979 register HE *entry;
980 register HE *oentry = Null(HE*);
a0d0e21e
LW
981 I32 riter;
982 I32 max;
79072805
LW
983
984 if (!hv)
985 return;
a0d0e21e 986 if (!HvARRAY(hv))
79072805 987 return;
a0d0e21e
LW
988
989 riter = 0;
990 max = HvMAX(hv);
991 array = HvARRAY(hv);
68dc0745 992 entry = array[0];
a0d0e21e 993 for (;;) {
68dc0745
PP
994 if (entry) {
995 oentry = entry;
996 entry = HeNEXT(entry);
997 hv_free_ent(hv, oentry);
a0d0e21e 998 }
68dc0745 999 if (!entry) {
a0d0e21e
LW
1000 if (++riter > max)
1001 break;
68dc0745 1002 entry = array[riter];
a0d0e21e 1003 }
79072805 1004 }
a0d0e21e 1005 (void)hv_iterinit(hv);
79072805
LW
1006}
1007
1008void
864dbfa3 1009Perl_hv_undef(pTHX_ HV *hv)
79072805
LW
1010{
1011 register XPVHV* xhv;
1012 if (!hv)
1013 return;
1014 xhv = (XPVHV*)SvANY(hv);
463ee0b2 1015 hfreeentries(hv);
79072805 1016 Safefree(xhv->xhv_array);
85e6fe83
LW
1017 if (HvNAME(hv)) {
1018 Safefree(HvNAME(hv));
1019 HvNAME(hv) = 0;
1020 }
79072805 1021 xhv->xhv_array = 0;
aa689395 1022 xhv->xhv_max = 7; /* it's a normal hash */
79072805 1023 xhv->xhv_fill = 0;
a0d0e21e
LW
1024 xhv->xhv_keys = 0;
1025
1026 if (SvRMAGICAL(hv))
1027 mg_clear((SV*)hv);
79072805
LW
1028}
1029
79072805 1030I32
864dbfa3 1031Perl_hv_iterinit(pTHX_ HV *hv)
79072805 1032{
aa689395
PP
1033 register XPVHV* xhv;
1034 HE *entry;
1035
1036 if (!hv)
cea2e8a9 1037 Perl_croak(aTHX_ "Bad hash");
aa689395
PP
1038 xhv = (XPVHV*)SvANY(hv);
1039 entry = xhv->xhv_eiter;
72940dca
PP
1040 if (entry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1041 HvLAZYDEL_off(hv);
68dc0745 1042 hv_free_ent(hv, entry);
72940dca 1043 }
79072805
LW
1044 xhv->xhv_riter = -1;
1045 xhv->xhv_eiter = Null(HE*);
c6601927 1046 return xhv->xhv_keys; /* used to be xhv->xhv_fill before 5.004_65 */
79072805
LW
1047}
1048
1049HE *
864dbfa3 1050Perl_hv_iternext(pTHX_ HV *hv)
79072805
LW
1051{
1052 register XPVHV* xhv;
1053 register HE *entry;
a0d0e21e 1054 HE *oldentry;
463ee0b2 1055 MAGIC* mg;
79072805
LW
1056
1057 if (!hv)
cea2e8a9 1058 Perl_croak(aTHX_ "Bad hash");
79072805 1059 xhv = (XPVHV*)SvANY(hv);
a0d0e21e 1060 oldentry = entry = xhv->xhv_eiter;
463ee0b2 1061
33c27489 1062 if (mg = SvTIED_mg((SV*)hv, 'P')) {
8990e307 1063 SV *key = sv_newmortal();
cd1469e6 1064 if (entry) {
fde52b5c 1065 sv_setsv(key, HeSVKEY_force(entry));
cd1469e6
PP
1066 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
1067 }
a0d0e21e 1068 else {
ff68c719 1069 char *k;
bbce6d69 1070 HEK *hek;
ff68c719
PP
1071
1072 xhv->xhv_eiter = entry = new_he(); /* one HE per MAGICAL hash */
4633a7c4 1073 Zero(entry, 1, HE);
ff68c719
PP
1074 Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1075 hek = (HEK*)k;
1076 HeKEY_hek(entry) = hek;
fde52b5c 1077 HeKLEN(entry) = HEf_SVKEY;
a0d0e21e
LW
1078 }
1079 magic_nextpack((SV*) hv,mg,key);
463ee0b2 1080 if (SvOK(key)) {
cd1469e6 1081 /* force key to stay around until next time */
bbce6d69
PP
1082 HeSVKEY_set(entry, SvREFCNT_inc(key));
1083 return entry; /* beware, hent_val is not set */
463ee0b2 1084 }
fde52b5c
PP
1085 if (HeVAL(entry))
1086 SvREFCNT_dec(HeVAL(entry));
ff68c719 1087 Safefree(HeKEY_hek(entry));
4633a7c4 1088 del_he(entry);
463ee0b2
LW
1089 xhv->xhv_eiter = Null(HE*);
1090 return Null(HE*);
79072805 1091 }
f675dbe5
CB
1092#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
1093 if (!entry && HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
1094 prime_env_iter();
1095#endif
463ee0b2 1096
79072805 1097 if (!xhv->xhv_array)
d18c6117
GS
1098 Newz(506, xhv->xhv_array,
1099 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max + 1), char);
fde52b5c
PP
1100 if (entry)
1101 entry = HeNEXT(entry);
1102 while (!entry) {
1103 ++xhv->xhv_riter;
1104 if (xhv->xhv_riter > xhv->xhv_max) {
1105 xhv->xhv_riter = -1;
1106 break;
79072805 1107 }
fde52b5c
PP
1108 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1109 }
79072805 1110
72940dca
PP
1111 if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
1112 HvLAZYDEL_off(hv);
68dc0745 1113 hv_free_ent(hv, oldentry);
72940dca 1114 }
a0d0e21e 1115
79072805
LW
1116 xhv->xhv_eiter = entry;
1117 return entry;
1118}
1119
1120char *
864dbfa3 1121Perl_hv_iterkey(pTHX_ register HE *entry, I32 *retlen)
79072805 1122{
fde52b5c 1123 if (HeKLEN(entry) == HEf_SVKEY) {
fb73857a
PP
1124 STRLEN len;
1125 char *p = SvPV(HeKEY_sv(entry), len);
1126 *retlen = len;
1127 return p;
fde52b5c
PP
1128 }
1129 else {
1130 *retlen = HeKLEN(entry);
1131 return HeKEY(entry);
1132 }
1133}
1134
1135/* unlike hv_iterval(), this always returns a mortal copy of the key */
1136SV *
864dbfa3 1137Perl_hv_iterkeysv(pTHX_ register HE *entry)
fde52b5c
PP
1138{
1139 if (HeKLEN(entry) == HEf_SVKEY)
bbce6d69 1140 return sv_mortalcopy(HeKEY_sv(entry));
fde52b5c 1141 else
79cb57f6 1142 return sv_2mortal(newSVpvn((HeKLEN(entry) ? HeKEY(entry) : ""),
fde52b5c 1143 HeKLEN(entry)));
79072805
LW
1144}
1145
1146SV *
864dbfa3 1147Perl_hv_iterval(pTHX_ HV *hv, register HE *entry)
79072805 1148{
8990e307 1149 if (SvRMAGICAL(hv)) {
463ee0b2 1150 if (mg_find((SV*)hv,'P')) {
8990e307 1151 SV* sv = sv_newmortal();
bbce6d69
PP
1152 if (HeKLEN(entry) == HEf_SVKEY)
1153 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1154 else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
463ee0b2
LW
1155 return sv;
1156 }
79072805 1157 }
fde52b5c 1158 return HeVAL(entry);
79072805
LW
1159}
1160
a0d0e21e 1161SV *
864dbfa3 1162Perl_hv_iternextsv(pTHX_ HV *hv, char **key, I32 *retlen)
a0d0e21e
LW
1163{
1164 HE *he;
1165 if ( (he = hv_iternext(hv)) == NULL)
1166 return NULL;
1167 *key = hv_iterkey(he, retlen);
1168 return hv_iterval(hv, he);
1169}
1170
79072805 1171void
864dbfa3 1172Perl_hv_magic(pTHX_ HV *hv, GV *gv, int how)
79072805 1173{
a0d0e21e 1174 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
79072805 1175}
fde52b5c 1176
bbce6d69 1177char*
864dbfa3 1178Perl_sharepvn(pTHX_ const char *sv, I32 len, U32 hash)
bbce6d69 1179{
ff68c719 1180 return HEK_KEY(share_hek(sv, len, hash));
bbce6d69
PP
1181}
1182
1183/* possibly free a shared string if no one has access to it
fde52b5c
PP
1184 * len and hash must both be valid for str.
1185 */
bbce6d69 1186void
864dbfa3 1187Perl_unsharepvn(pTHX_ const char *str, I32 len, U32 hash)
fde52b5c
PP
1188{
1189 register XPVHV* xhv;
1190 register HE *entry;
1191 register HE **oentry;
1192 register I32 i = 1;
1193 I32 found = 0;
bbce6d69 1194
fde52b5c 1195 /* what follows is the moral equivalent of:
6b88bc9c 1196 if ((Svp = hv_fetch(PL_strtab, tmpsv, FALSE, hash))) {
bbce6d69 1197 if (--*Svp == Nullsv)
6b88bc9c 1198 hv_delete(PL_strtab, str, len, G_DISCARD, hash);
bbce6d69 1199 } */
3280af22 1200 xhv = (XPVHV*)SvANY(PL_strtab);
fde52b5c 1201 /* assert(xhv_array != 0) */
5f08fbcd 1202 LOCK_STRTAB_MUTEX;
fde52b5c 1203 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
bbce6d69 1204 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
fde52b5c
PP
1205 if (HeHASH(entry) != hash) /* strings can't be equal */
1206 continue;
1207 if (HeKLEN(entry) != len)
1208 continue;
36477c24 1209 if (memNE(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
1210 continue;
1211 found = 1;
bbce6d69
PP
1212 if (--HeVAL(entry) == Nullsv) {
1213 *oentry = HeNEXT(entry);
1214 if (i && !*oentry)
1215 xhv->xhv_fill--;
ff68c719 1216 Safefree(HeKEY_hek(entry));
bbce6d69
PP
1217 del_he(entry);
1218 --xhv->xhv_keys;
fde52b5c 1219 }
bbce6d69 1220 break;
fde52b5c 1221 }
333f433b 1222 UNLOCK_STRTAB_MUTEX;
bbce6d69 1223
0453d815
PM
1224 {
1225 dTHR;
1226 if (!found && ckWARN_d(WARN_INTERNAL))
1227 Perl_warner(aTHX_ WARN_INTERNAL, "Attempt to free non-existent shared string");
1228 }
fde52b5c
PP
1229}
1230
bbce6d69
PP
1231/* get a (constant) string ptr from the global string table
1232 * string will get added if it is not already there.
fde52b5c
PP
1233 * len and hash must both be valid for str.
1234 */
bbce6d69 1235HEK *
864dbfa3 1236Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
fde52b5c
PP
1237{
1238 register XPVHV* xhv;
1239 register HE *entry;
1240 register HE **oentry;
1241 register I32 i = 1;
1242 I32 found = 0;
bbce6d69 1243
fde52b5c 1244 /* what follows is the moral equivalent of:
bbce6d69 1245
6b88bc9c
GS
1246 if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
1247 hv_store(PL_strtab, str, len, Nullsv, hash);
bbce6d69 1248 */
3280af22 1249 xhv = (XPVHV*)SvANY(PL_strtab);
fde52b5c 1250 /* assert(xhv_array != 0) */
5f08fbcd 1251 LOCK_STRTAB_MUTEX;
fde52b5c 1252 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
bbce6d69 1253 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
fde52b5c
PP
1254 if (HeHASH(entry) != hash) /* strings can't be equal */
1255 continue;
1256 if (HeKLEN(entry) != len)
1257 continue;
36477c24 1258 if (memNE(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
1259 continue;
1260 found = 1;
fde52b5c
PP
1261 break;
1262 }
bbce6d69
PP
1263 if (!found) {
1264 entry = new_he();
ff68c719 1265 HeKEY_hek(entry) = save_hek(str, len, hash);
bbce6d69
PP
1266 HeVAL(entry) = Nullsv;
1267 HeNEXT(entry) = *oentry;
1268 *oentry = entry;
1269 xhv->xhv_keys++;
1270 if (i) { /* initial entry? */
1271 ++xhv->xhv_fill;
1272 if (xhv->xhv_keys > xhv->xhv_max)
3280af22 1273 hsplit(PL_strtab);
bbce6d69
PP
1274 }
1275 }
1276
1277 ++HeVAL(entry); /* use value slot as REFCNT */
5f08fbcd 1278 UNLOCK_STRTAB_MUTEX;
ff68c719 1279 return HeKEY_hek(entry);
fde52b5c
PP
1280}
1281
bbce6d69 1282
61c8b479 1283