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