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