This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Dale's posting as patch (Was: Perl 5.003_5 make fails on NS3.2 - CURED)
[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)
fde52b5c 397 HeKLEN(entry) = HEf_LAZYDEL;
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)
459 HeKLEN(entry) = HEf_LAZYDEL;
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
622HV *
463ee0b2 623newHV()
79072805
LW
624{
625 register HV *hv;
626 register XPVHV* xhv;
627
a0d0e21e
LW
628 hv = (HV*)NEWSV(502,0);
629 sv_upgrade((SV *)hv, SVt_PVHV);
79072805
LW
630 xhv = (XPVHV*)SvANY(hv);
631 SvPOK_off(hv);
632 SvNOK_off(hv);
fde52b5c
PP
633#ifndef NODEFAULT_SHAREKEYS
634 HvSHAREKEYS_on(hv); /* key-sharing on by default */
635#endif
463ee0b2 636 xhv->xhv_max = 7; /* start with 8 buckets */
79072805
LW
637 xhv->xhv_fill = 0;
638 xhv->xhv_pmroot = 0;
79072805
LW
639 (void)hv_iterinit(hv); /* so each() will start off right */
640 return hv;
641}
642
643void
fde52b5c 644he_free(hent, shared)
79072805 645register HE *hent;
fde52b5c 646I32 shared;
79072805
LW
647{
648 if (!hent)
649 return;
fde52b5c
PP
650 SvREFCNT_dec(HeVAL(hent));
651 if (HeKLEN(hent) == HEf_SVKEY)
652 SvREFCNT_dec((SV*)HeKEY(hent));
653 else if (shared)
654 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
655 else
656 Safefree(HeKEY(hent));
4633a7c4 657 del_he(hent);
79072805
LW
658}
659
660void
fde52b5c 661he_delayfree(hent, shared)
79072805 662register HE *hent;
fde52b5c 663I32 shared;
79072805
LW
664{
665 if (!hent)
666 return;
fde52b5c
PP
667 sv_2mortal(HeVAL(hent)); /* free between statements */
668 if (HeKLEN(hent) == HEf_SVKEY)
669 sv_2mortal((SV*)HeKEY(hent));
670 else if (shared)
671 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
672 else
673 Safefree(HeKEY(hent));
4633a7c4 674 del_he(hent);
79072805
LW
675}
676
677void
463ee0b2 678hv_clear(hv)
79072805 679HV *hv;
79072805
LW
680{
681 register XPVHV* xhv;
682 if (!hv)
683 return;
684 xhv = (XPVHV*)SvANY(hv);
463ee0b2 685 hfreeentries(hv);
79072805 686 xhv->xhv_fill = 0;
a0d0e21e 687 xhv->xhv_keys = 0;
79072805 688 if (xhv->xhv_array)
463ee0b2 689 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
a0d0e21e
LW
690
691 if (SvRMAGICAL(hv))
692 mg_clear((SV*)hv);
79072805
LW
693}
694
695static void
463ee0b2 696hfreeentries(hv)
79072805 697HV *hv;
79072805 698{
a0d0e21e 699 register HE **array;
79072805
LW
700 register HE *hent;
701 register HE *ohent = Null(HE*);
a0d0e21e
LW
702 I32 riter;
703 I32 max;
fde52b5c 704 I32 shared;
79072805
LW
705
706 if (!hv)
707 return;
a0d0e21e 708 if (!HvARRAY(hv))
79072805 709 return;
a0d0e21e
LW
710
711 riter = 0;
712 max = HvMAX(hv);
713 array = HvARRAY(hv);
714 hent = array[0];
fde52b5c 715 shared = HvSHAREKEYS(hv);
a0d0e21e
LW
716 for (;;) {
717 if (hent) {
718 ohent = hent;
fde52b5c
PP
719 hent = HeNEXT(hent);
720 he_free(ohent, shared);
a0d0e21e
LW
721 }
722 if (!hent) {
723 if (++riter > max)
724 break;
725 hent = array[riter];
726 }
79072805 727 }
a0d0e21e 728 (void)hv_iterinit(hv);
79072805
LW
729}
730
731void
463ee0b2 732hv_undef(hv)
79072805 733HV *hv;
79072805
LW
734{
735 register XPVHV* xhv;
736 if (!hv)
737 return;
738 xhv = (XPVHV*)SvANY(hv);
463ee0b2 739 hfreeentries(hv);
79072805 740 Safefree(xhv->xhv_array);
85e6fe83
LW
741 if (HvNAME(hv)) {
742 Safefree(HvNAME(hv));
743 HvNAME(hv) = 0;
744 }
79072805 745 xhv->xhv_array = 0;
463ee0b2 746 xhv->xhv_max = 7; /* it's a normal associative array */
79072805 747 xhv->xhv_fill = 0;
a0d0e21e
LW
748 xhv->xhv_keys = 0;
749
750 if (SvRMAGICAL(hv))
751 mg_clear((SV*)hv);
79072805
LW
752}
753
79072805
LW
754I32
755hv_iterinit(hv)
756HV *hv;
757{
758 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e 759 HE *entry = xhv->xhv_eiter;
effa1e2d
PP
760#ifdef DYNAMIC_ENV_FETCH /* set up %ENV for iteration */
761 if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) prime_env_iter();
762#endif
fde52b5c
PP
763 if (entry && HeKLEN(entry) == HEf_LAZYDEL) /* was deleted earlier? */
764 he_free(entry, HvSHAREKEYS(hv));
79072805
LW
765 xhv->xhv_riter = -1;
766 xhv->xhv_eiter = Null(HE*);
767 return xhv->xhv_fill;
768}
769
770HE *
771hv_iternext(hv)
772HV *hv;
773{
774 register XPVHV* xhv;
775 register HE *entry;
a0d0e21e 776 HE *oldentry;
463ee0b2 777 MAGIC* mg;
79072805
LW
778
779 if (!hv)
463ee0b2 780 croak("Bad associative array");
79072805 781 xhv = (XPVHV*)SvANY(hv);
a0d0e21e 782 oldentry = entry = xhv->xhv_eiter;
463ee0b2 783
8990e307
LW
784 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
785 SV *key = sv_newmortal();
cd1469e6 786 if (entry) {
fde52b5c 787 sv_setsv(key, HeSVKEY_force(entry));
cd1469e6
PP
788 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
789 }
a0d0e21e 790 else {
cd1469e6 791 xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */
4633a7c4 792 Zero(entry, 1, HE);
fde52b5c 793 HeKLEN(entry) = HEf_SVKEY;
a0d0e21e
LW
794 }
795 magic_nextpack((SV*) hv,mg,key);
463ee0b2 796 if (SvOK(key)) {
cd1469e6 797 /* force key to stay around until next time */
fde52b5c
PP
798 HeKEY(entry) = (char*)SvREFCNT_inc(key);
799 return entry; /* beware, hent_val is not set */
463ee0b2 800 }
fde52b5c
PP
801 if (HeVAL(entry))
802 SvREFCNT_dec(HeVAL(entry));
4633a7c4 803 del_he(entry);
463ee0b2
LW
804 xhv->xhv_eiter = Null(HE*);
805 return Null(HE*);
79072805 806 }
463ee0b2 807
79072805 808 if (!xhv->xhv_array)
4633a7c4 809 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
fde52b5c
PP
810 if (entry)
811 entry = HeNEXT(entry);
812 while (!entry) {
813 ++xhv->xhv_riter;
814 if (xhv->xhv_riter > xhv->xhv_max) {
815 xhv->xhv_riter = -1;
816 break;
79072805 817 }
fde52b5c
PP
818 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
819 }
79072805 820
fde52b5c
PP
821 if (oldentry && HeKLEN(oldentry) == HEf_LAZYDEL) /* was deleted earlier? */
822 he_free(oldentry, HvSHAREKEYS(hv));
a0d0e21e 823
79072805
LW
824 xhv->xhv_eiter = entry;
825 return entry;
826}
827
828char *
829hv_iterkey(entry,retlen)
830register HE *entry;
831I32 *retlen;
832{
fde52b5c
PP
833 if (HeKLEN(entry) == HEf_SVKEY) {
834 return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen);
835 }
836 else {
837 *retlen = HeKLEN(entry);
838 return HeKEY(entry);
839 }
840}
841
842/* unlike hv_iterval(), this always returns a mortal copy of the key */
843SV *
844hv_iterkeysv(entry)
845register HE *entry;
846{
847 if (HeKLEN(entry) == HEf_SVKEY)
848 return sv_mortalcopy((SV*)HeKEY(entry));
849 else
850 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
851 HeKLEN(entry)));
79072805
LW
852}
853
854SV *
855hv_iterval(hv,entry)
856HV *hv;
857register HE *entry;
858{
8990e307 859 if (SvRMAGICAL(hv)) {
463ee0b2 860 if (mg_find((SV*)hv,'P')) {
8990e307 861 SV* sv = sv_newmortal();
fde52b5c 862 mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
463ee0b2
LW
863 return sv;
864 }
79072805 865 }
fde52b5c 866 return HeVAL(entry);
79072805
LW
867}
868
a0d0e21e
LW
869SV *
870hv_iternextsv(hv, key, retlen)
871 HV *hv;
872 char **key;
873 I32 *retlen;
874{
875 HE *he;
876 if ( (he = hv_iternext(hv)) == NULL)
877 return NULL;
878 *key = hv_iterkey(he, retlen);
879 return hv_iterval(hv, he);
880}
881
79072805
LW
882void
883hv_magic(hv, gv, how)
884HV* hv;
885GV* gv;
a0d0e21e 886int how;
79072805 887{
a0d0e21e 888 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
79072805 889}
fde52b5c
PP
890
891/* get a (constant) string ptr from the global string table
892 * string will get added if it is not already there.
893 * len and hash must both be valid for str.
894 */
895char *
896sharepvn(str, len, hash)
897char *str;
898I32 len;
899register U32 hash;
900{
901 register XPVHV* xhv;
902 register HE *entry;
903 register HE **oentry;
904 register I32 i = 1;
905 I32 found = 0;
906
907 /* what follows is the moral equivalent of:
908
909 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
910 hv_store(strtab, str, len, Nullsv, hash);
911 */
912 xhv = (XPVHV*)SvANY(strtab);
913 /* assert(xhv_array != 0) */
914 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
915 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
916 if (HeHASH(entry) != hash) /* strings can't be equal */
917 continue;
918 if (HeKLEN(entry) != len)
919 continue;
cd1469e6 920 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
921 continue;
922 found = 1;
923 break;
924 }
925 if (!found) {
926 entry = new_he();
927 HeKLEN(entry) = len;
928 HeKEY(entry) = savepvn(str,len);
929 HeVAL(entry) = Nullsv;
930 HeHASH(entry) = hash;
931 HeNEXT(entry) = *oentry;
932 *oentry = entry;
933 xhv->xhv_keys++;
934 if (i) { /* initial entry? */
935 ++xhv->xhv_fill;
936 if (xhv->xhv_keys > xhv->xhv_max)
937 hsplit(strtab);
938 }
939 }
940
941 ++HeVAL(entry); /* use value slot as REFCNT */
942 return HeKEY(entry);
943}
944
945/* possibly free a shared string if no one has access to it
946 * len and hash must both be valid for str.
947 */
948void
949unsharepvn(str, len, hash)
950char *str;
951I32 len;
952register U32 hash;
953{
954 register XPVHV* xhv;
955 register HE *entry;
956 register HE **oentry;
957 register I32 i = 1;
958 I32 found = 0;
959
960 /* what follows is the moral equivalent of:
961 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
962 if (--*Svp == Nullsv)
963 hv_delete(strtab, str, len, G_DISCARD, hash);
964 } */
965 xhv = (XPVHV*)SvANY(strtab);
966 /* assert(xhv_array != 0) */
967 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
968 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
969 if (HeHASH(entry) != hash) /* strings can't be equal */
970 continue;
971 if (HeKLEN(entry) != len)
972 continue;
cd1469e6 973 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
974 continue;
975 found = 1;
976 if (--HeVAL(entry) == Nullsv) {
977 *oentry = HeNEXT(entry);
978 if (i && !*oentry)
979 xhv->xhv_fill--;
980 Safefree(HeKEY(entry));
981 del_he(entry);
982 --xhv->xhv_keys;
983 }
984 break;
985 }
986
987 if (!found)
988 warn("Attempt to free non-existent shared string");
989}
990