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