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