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