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