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