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