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