This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 5.003_05: hints/sunos_4_1.sh
[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
145 xhv = (XPVHV*)SvANY(hv);
146
147 if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
fde52b5c
PP
148 sv = sv_newmortal();
149 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
cd1469e6 150 entry = &He;
fde52b5c 151 HeVAL(entry) = sv;
cd1469e6
PP
152 HeKEY(entry) = (char*)keysv;
153 HeKLEN(entry) = HEf_SVKEY; /* hent_key is holding an SV* */
fde52b5c
PP
154 return entry;
155 }
156
157 key = SvPV(keysv, klen);
158
159 if (!hash)
160 PERL_HASH(hash, key, klen);
161
162 if (!xhv->xhv_array) {
163 if (lval
164#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
165 || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
166#endif
167 )
168 Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
169 else
170 return 0;
171 }
172
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)) {
290 mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
291#ifndef OVERLOAD
292 if (!xhv->xhv_array)
293 return Nullhe;
294#else
295 if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
296 || SvMAGIC(hv)->mg_moremagic))
297 return Nullhe;
298#endif /* OVERLOAD */
299 }
300
301 key = SvPV(keysv, klen);
302
303 if (!hash)
304 PERL_HASH(hash, key, klen);
305
79072805 306 if (!xhv->xhv_array)
463ee0b2 307 Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
79072805 308
a0d0e21e 309 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
310 i = 1;
311
fde52b5c
PP
312 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
313 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 314 continue;
fde52b5c 315 if (HeKLEN(entry) != klen)
79072805 316 continue;
cd1469e6 317 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
79072805 318 continue;
fde52b5c
PP
319 SvREFCNT_dec(HeVAL(entry));
320 HeVAL(entry) = val;
321 return entry;
79072805 322 }
79072805 323
4633a7c4 324 entry = new_he();
fde52b5c
PP
325 HeKLEN(entry) = klen;
326 if (HvSHAREKEYS(hv))
327 HeKEY(entry) = sharepvn(key, klen, hash);
328 else /* gotta do the real thing */
329 HeKEY(entry) = savepvn(key,klen);
330 HeVAL(entry) = val;
331 HeHASH(entry) = hash;
332 HeNEXT(entry) = *oentry;
79072805
LW
333 *oentry = entry;
334
463ee0b2 335 xhv->xhv_keys++;
79072805 336 if (i) { /* initial entry? */
463ee0b2
LW
337 ++xhv->xhv_fill;
338 if (xhv->xhv_keys > xhv->xhv_max)
79072805
LW
339 hsplit(hv);
340 }
79072805 341
fde52b5c 342 return entry;
79072805
LW
343}
344
345SV *
748a9306 346hv_delete(hv,key,klen,flags)
79072805
LW
347HV *hv;
348char *key;
349U32 klen;
748a9306 350I32 flags;
79072805
LW
351{
352 register XPVHV* xhv;
79072805 353 register I32 i;
fde52b5c 354 register U32 hash;
79072805
LW
355 register HE *entry;
356 register HE **oentry;
357 SV *sv;
79072805
LW
358
359 if (!hv)
360 return Nullsv;
8990e307 361 if (SvRMAGICAL(hv)) {
463ee0b2
LW
362 sv = *hv_fetch(hv, key, klen, TRUE);
363 mg_clear(sv);
fde52b5c
PP
364 if (mg_find(sv, 's')) {
365 return Nullsv; /* %SIG elements cannot be deleted */
366 }
a0d0e21e
LW
367 if (mg_find(sv, 'p')) {
368 sv_unmagic(sv, 'p'); /* No longer an element */
369 return sv;
370 }
463ee0b2 371 }
79072805
LW
372 xhv = (XPVHV*)SvANY(hv);
373 if (!xhv->xhv_array)
374 return Nullsv;
fde52b5c
PP
375
376 PERL_HASH(hash, key, klen);
79072805 377
a0d0e21e 378 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
79072805
LW
379 entry = *oentry;
380 i = 1;
fde52b5c
PP
381 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
382 if (HeHASH(entry) != hash) /* strings can't be equal */
79072805 383 continue;
fde52b5c 384 if (HeKLEN(entry) != klen)
79072805 385 continue;
cd1469e6 386 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
79072805 387 continue;
fde52b5c 388 *oentry = HeNEXT(entry);
79072805
LW
389 if (i && !*oentry)
390 xhv->xhv_fill--;
748a9306
LW
391 if (flags & G_DISCARD)
392 sv = Nullsv;
393 else
fde52b5c 394 sv = sv_mortalcopy(HeVAL(entry));
a0d0e21e 395 if (entry == xhv->xhv_eiter)
fde52b5c 396 HeKLEN(entry) = HEf_LAZYDEL;
a0d0e21e 397 else
fde52b5c
PP
398 he_free(entry, HvSHAREKEYS(hv));
399 --xhv->xhv_keys;
400 return sv;
401 }
402 return Nullsv;
403}
404
405SV *
406hv_delete_ent(hv,keysv,flags,hash)
407HV *hv;
408SV *keysv;
409I32 flags;
410U32 hash;
411{
412 register XPVHV* xhv;
413 register I32 i;
414 register char *key;
415 STRLEN klen;
416 register HE *entry;
417 register HE **oentry;
418 SV *sv;
419
420 if (!hv)
421 return Nullsv;
422 if (SvRMAGICAL(hv)) {
423 entry = hv_fetch_ent(hv, keysv, TRUE, hash);
424 sv = HeVAL(entry);
425 mg_clear(sv);
426 if (mg_find(sv, 'p')) {
427 sv_unmagic(sv, 'p'); /* No longer an element */
428 return sv;
429 }
430 }
431 xhv = (XPVHV*)SvANY(hv);
432 if (!xhv->xhv_array)
433 return Nullsv;
434
435 key = SvPV(keysv, klen);
436
437 if (!hash)
438 PERL_HASH(hash, key, klen);
439
440 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
441 entry = *oentry;
442 i = 1;
443 for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
444 if (HeHASH(entry) != hash) /* strings can't be equal */
445 continue;
446 if (HeKLEN(entry) != klen)
447 continue;
cd1469e6 448 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
449 continue;
450 *oentry = HeNEXT(entry);
451 if (i && !*oentry)
452 xhv->xhv_fill--;
453 if (flags & G_DISCARD)
454 sv = Nullsv;
455 else
456 sv = sv_mortalcopy(HeVAL(entry));
457 if (entry == xhv->xhv_eiter)
458 HeKLEN(entry) = HEf_LAZYDEL;
459 else
460 he_free(entry, HvSHAREKEYS(hv));
463ee0b2 461 --xhv->xhv_keys;
79072805
LW
462 return sv;
463 }
79072805 464 return Nullsv;
79072805
LW
465}
466
a0d0e21e
LW
467bool
468hv_exists(hv,key,klen)
469HV *hv;
470char *key;
471U32 klen;
472{
473 register XPVHV* xhv;
fde52b5c 474 register U32 hash;
a0d0e21e
LW
475 register HE *entry;
476 SV *sv;
477
478 if (!hv)
479 return 0;
480
481 if (SvRMAGICAL(hv)) {
482 if (mg_find((SV*)hv,'P')) {
483 sv = sv_newmortal();
484 mg_copy((SV*)hv, sv, key, klen);
485 magic_existspack(sv, mg_find(sv, 'p'));
486 return SvTRUE(sv);
487 }
488 }
489
490 xhv = (XPVHV*)SvANY(hv);
491 if (!xhv->xhv_array)
492 return 0;
493
fde52b5c 494 PERL_HASH(hash, key, klen);
a0d0e21e
LW
495
496 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
fde52b5c
PP
497 for (; entry; entry = HeNEXT(entry)) {
498 if (HeHASH(entry) != hash) /* strings can't be equal */
a0d0e21e 499 continue;
fde52b5c 500 if (HeKLEN(entry) != klen)
a0d0e21e 501 continue;
cd1469e6 502 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
fde52b5c
PP
503 continue;
504 return TRUE;
505 }
506 return FALSE;
507}
508
509
510bool
511hv_exists_ent(hv,keysv,hash)
512HV *hv;
513SV *keysv;
514U32 hash;
515{
516 register XPVHV* xhv;
517 register char *key;
518 STRLEN klen;
519 register HE *entry;
520 SV *sv;
521
522 if (!hv)
523 return 0;
524
525 if (SvRMAGICAL(hv)) {
526 if (mg_find((SV*)hv,'P')) {
527 sv = sv_newmortal();
528 mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
529 magic_existspack(sv, mg_find(sv, 'p'));
530 return SvTRUE(sv);
531 }
532 }
533
534 xhv = (XPVHV*)SvANY(hv);
535 if (!xhv->xhv_array)
536 return 0;
537
538 key = SvPV(keysv, klen);
539 if (!hash)
540 PERL_HASH(hash, key, klen);
541
542 entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
543 for (; entry; entry = HeNEXT(entry)) {
544 if (HeHASH(entry) != hash) /* strings can't be equal */
545 continue;
546 if (HeKLEN(entry) != klen)
547 continue;
cd1469e6 548 if (memcmp(HeKEY(entry),key,klen)) /* is this it? */
a0d0e21e
LW
549 continue;
550 return TRUE;
551 }
552 return FALSE;
553}
554
79072805
LW
555static void
556hsplit(hv)
557HV *hv;
558{
559 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e 560 I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
79072805
LW
561 register I32 newsize = oldsize * 2;
562 register I32 i;
563 register HE **a;
564 register HE **b;
565 register HE *entry;
566 register HE **oentry;
c07a80fd 567#ifndef STRANGE_MALLOC
4633a7c4 568 I32 tmp;
c07a80fd 569#endif
79072805 570
463ee0b2 571 a = (HE**)xhv->xhv_array;
79072805 572 nomemok = TRUE;
4633a7c4 573#ifdef STRANGE_MALLOC
79072805 574 Renew(a, newsize, HE*);
4633a7c4
LW
575#else
576 i = newsize * sizeof(HE*);
577#define MALLOC_OVERHEAD 16
578 tmp = MALLOC_OVERHEAD;
579 while (tmp - MALLOC_OVERHEAD < i)
580 tmp += tmp;
581 tmp -= MALLOC_OVERHEAD;
582 tmp /= sizeof(HE*);
583 assert(tmp >= newsize);
584 New(2,a, tmp, HE*);
585 Copy(xhv->xhv_array, a, oldsize, HE*);
c07a80fd
PP
586 if (oldsize >= 64 && !nice_chunk) {
587 nice_chunk = (char*)xhv->xhv_array;
588 nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
4633a7c4
LW
589 }
590 else
591 Safefree(xhv->xhv_array);
592#endif
593
79072805 594 nomemok = FALSE;
79072805
LW
595 Zero(&a[oldsize], oldsize, HE*); /* zero 2nd half*/
596 xhv->xhv_max = --newsize;
463ee0b2 597 xhv->xhv_array = (char*)a;
79072805
LW
598
599 for (i=0; i<oldsize; i++,a++) {
600 if (!*a) /* non-existent */
601 continue;
602 b = a+oldsize;
603 for (oentry = a, entry = *a; entry; entry = *oentry) {
fde52b5c
PP
604 if ((HeHASH(entry) & newsize) != i) {
605 *oentry = HeNEXT(entry);
606 HeNEXT(entry) = *b;
79072805
LW
607 if (!*b)
608 xhv->xhv_fill++;
609 *b = entry;
610 continue;
611 }
612 else
fde52b5c 613 oentry = &HeNEXT(entry);
79072805
LW
614 }
615 if (!*a) /* everything moved */
616 xhv->xhv_fill--;
617 }
618}
619
620HV *
463ee0b2 621newHV()
79072805
LW
622{
623 register HV *hv;
624 register XPVHV* xhv;
625
a0d0e21e
LW
626 hv = (HV*)NEWSV(502,0);
627 sv_upgrade((SV *)hv, SVt_PVHV);
79072805
LW
628 xhv = (XPVHV*)SvANY(hv);
629 SvPOK_off(hv);
630 SvNOK_off(hv);
fde52b5c
PP
631#ifndef NODEFAULT_SHAREKEYS
632 HvSHAREKEYS_on(hv); /* key-sharing on by default */
633#endif
463ee0b2 634 xhv->xhv_max = 7; /* start with 8 buckets */
79072805
LW
635 xhv->xhv_fill = 0;
636 xhv->xhv_pmroot = 0;
79072805
LW
637 (void)hv_iterinit(hv); /* so each() will start off right */
638 return hv;
639}
640
641void
fde52b5c 642he_free(hent, shared)
79072805 643register HE *hent;
fde52b5c 644I32 shared;
79072805
LW
645{
646 if (!hent)
647 return;
fde52b5c
PP
648 SvREFCNT_dec(HeVAL(hent));
649 if (HeKLEN(hent) == HEf_SVKEY)
650 SvREFCNT_dec((SV*)HeKEY(hent));
651 else if (shared)
652 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
653 else
654 Safefree(HeKEY(hent));
4633a7c4 655 del_he(hent);
79072805
LW
656}
657
658void
fde52b5c 659he_delayfree(hent, shared)
79072805 660register HE *hent;
fde52b5c 661I32 shared;
79072805
LW
662{
663 if (!hent)
664 return;
fde52b5c
PP
665 sv_2mortal(HeVAL(hent)); /* free between statements */
666 if (HeKLEN(hent) == HEf_SVKEY)
667 sv_2mortal((SV*)HeKEY(hent));
668 else if (shared)
669 unsharepvn(HeKEY(hent), HeKLEN(hent), HeHASH(hent));
670 else
671 Safefree(HeKEY(hent));
4633a7c4 672 del_he(hent);
79072805
LW
673}
674
675void
463ee0b2 676hv_clear(hv)
79072805 677HV *hv;
79072805
LW
678{
679 register XPVHV* xhv;
680 if (!hv)
681 return;
682 xhv = (XPVHV*)SvANY(hv);
463ee0b2 683 hfreeentries(hv);
79072805 684 xhv->xhv_fill = 0;
a0d0e21e 685 xhv->xhv_keys = 0;
79072805 686 if (xhv->xhv_array)
463ee0b2 687 (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
a0d0e21e
LW
688
689 if (SvRMAGICAL(hv))
690 mg_clear((SV*)hv);
79072805
LW
691}
692
693static void
463ee0b2 694hfreeentries(hv)
79072805 695HV *hv;
79072805 696{
a0d0e21e 697 register HE **array;
79072805
LW
698 register HE *hent;
699 register HE *ohent = Null(HE*);
a0d0e21e
LW
700 I32 riter;
701 I32 max;
fde52b5c 702 I32 shared;
79072805
LW
703
704 if (!hv)
705 return;
a0d0e21e 706 if (!HvARRAY(hv))
79072805 707 return;
a0d0e21e
LW
708
709 riter = 0;
710 max = HvMAX(hv);
711 array = HvARRAY(hv);
712 hent = array[0];
fde52b5c 713 shared = HvSHAREKEYS(hv);
a0d0e21e
LW
714 for (;;) {
715 if (hent) {
716 ohent = hent;
fde52b5c
PP
717 hent = HeNEXT(hent);
718 he_free(ohent, shared);
a0d0e21e
LW
719 }
720 if (!hent) {
721 if (++riter > max)
722 break;
723 hent = array[riter];
724 }
79072805 725 }
a0d0e21e 726 (void)hv_iterinit(hv);
79072805
LW
727}
728
729void
463ee0b2 730hv_undef(hv)
79072805 731HV *hv;
79072805
LW
732{
733 register XPVHV* xhv;
734 if (!hv)
735 return;
736 xhv = (XPVHV*)SvANY(hv);
463ee0b2 737 hfreeentries(hv);
79072805 738 Safefree(xhv->xhv_array);
85e6fe83
LW
739 if (HvNAME(hv)) {
740 Safefree(HvNAME(hv));
741 HvNAME(hv) = 0;
742 }
79072805 743 xhv->xhv_array = 0;
463ee0b2 744 xhv->xhv_max = 7; /* it's a normal associative array */
79072805 745 xhv->xhv_fill = 0;
a0d0e21e
LW
746 xhv->xhv_keys = 0;
747
748 if (SvRMAGICAL(hv))
749 mg_clear((SV*)hv);
79072805
LW
750}
751
79072805
LW
752I32
753hv_iterinit(hv)
754HV *hv;
755{
756 register XPVHV* xhv = (XPVHV*)SvANY(hv);
a0d0e21e 757 HE *entry = xhv->xhv_eiter;
fde52b5c
PP
758 if (entry && HeKLEN(entry) == HEf_LAZYDEL) /* was deleted earlier? */
759 he_free(entry, HvSHAREKEYS(hv));
79072805
LW
760 xhv->xhv_riter = -1;
761 xhv->xhv_eiter = Null(HE*);
762 return xhv->xhv_fill;
763}
764
765HE *
766hv_iternext(hv)
767HV *hv;
768{
769 register XPVHV* xhv;
770 register HE *entry;
a0d0e21e 771 HE *oldentry;
463ee0b2 772 MAGIC* mg;
79072805
LW
773
774 if (!hv)
463ee0b2 775 croak("Bad associative array");
79072805 776 xhv = (XPVHV*)SvANY(hv);
a0d0e21e 777 oldentry = entry = xhv->xhv_eiter;
463ee0b2 778
8990e307
LW
779 if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
780 SV *key = sv_newmortal();
cd1469e6 781 if (entry) {
fde52b5c 782 sv_setsv(key, HeSVKEY_force(entry));
cd1469e6
PP
783 SvREFCNT_dec(HeSVKEY(entry)); /* get rid of previous key */
784 }
a0d0e21e 785 else {
cd1469e6 786 xhv->xhv_eiter = entry = new_he(); /* only one HE per MAGICAL hash */
4633a7c4 787 Zero(entry, 1, HE);
fde52b5c 788 HeKLEN(entry) = HEf_SVKEY;
a0d0e21e
LW
789 }
790 magic_nextpack((SV*) hv,mg,key);
463ee0b2 791 if (SvOK(key)) {
cd1469e6 792 /* force key to stay around until next time */
fde52b5c
PP
793 HeKEY(entry) = (char*)SvREFCNT_inc(key);
794 return entry; /* beware, hent_val is not set */
463ee0b2 795 }
fde52b5c
PP
796 if (HeVAL(entry))
797 SvREFCNT_dec(HeVAL(entry));
4633a7c4 798 del_he(entry);
463ee0b2
LW
799 xhv->xhv_eiter = Null(HE*);
800 return Null(HE*);
79072805 801 }
463ee0b2 802
79072805 803 if (!xhv->xhv_array)
4633a7c4 804 Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
fde52b5c
PP
805 if (entry)
806 entry = HeNEXT(entry);
807 while (!entry) {
808 ++xhv->xhv_riter;
809 if (xhv->xhv_riter > xhv->xhv_max) {
810 xhv->xhv_riter = -1;
811 break;
79072805 812 }
fde52b5c
PP
813 entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
814 }
79072805 815
fde52b5c
PP
816 if (oldentry && HeKLEN(oldentry) == HEf_LAZYDEL) /* was deleted earlier? */
817 he_free(oldentry, HvSHAREKEYS(hv));
a0d0e21e 818
79072805
LW
819 xhv->xhv_eiter = entry;
820 return entry;
821}
822
823char *
824hv_iterkey(entry,retlen)
825register HE *entry;
826I32 *retlen;
827{
fde52b5c
PP
828 if (HeKLEN(entry) == HEf_SVKEY) {
829 return SvPV((SV*)HeKEY(entry), *(STRLEN*)retlen);
830 }
831 else {
832 *retlen = HeKLEN(entry);
833 return HeKEY(entry);
834 }
835}
836
837/* unlike hv_iterval(), this always returns a mortal copy of the key */
838SV *
839hv_iterkeysv(entry)
840register HE *entry;
841{
842 if (HeKLEN(entry) == HEf_SVKEY)
843 return sv_mortalcopy((SV*)HeKEY(entry));
844 else
845 return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
846 HeKLEN(entry)));
79072805
LW
847}
848
849SV *
850hv_iterval(hv,entry)
851HV *hv;
852register HE *entry;
853{
8990e307 854 if (SvRMAGICAL(hv)) {
463ee0b2 855 if (mg_find((SV*)hv,'P')) {
8990e307 856 SV* sv = sv_newmortal();
fde52b5c 857 mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
463ee0b2
LW
858 return sv;
859 }
79072805 860 }
fde52b5c 861 return HeVAL(entry);
79072805
LW
862}
863
a0d0e21e
LW
864SV *
865hv_iternextsv(hv, key, retlen)
866 HV *hv;
867 char **key;
868 I32 *retlen;
869{
870 HE *he;
871 if ( (he = hv_iternext(hv)) == NULL)
872 return NULL;
873 *key = hv_iterkey(he, retlen);
874 return hv_iterval(hv, he);
875}
876
79072805
LW
877void
878hv_magic(hv, gv, how)
879HV* hv;
880GV* gv;
a0d0e21e 881int how;
79072805 882{
a0d0e21e 883 sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
79072805 884}
fde52b5c
PP
885
886/* get a (constant) string ptr from the global string table
887 * string will get added if it is not already there.
888 * len and hash must both be valid for str.
889 */
890char *
891sharepvn(str, len, hash)
892char *str;
893I32 len;
894register U32 hash;
895{
896 register XPVHV* xhv;
897 register HE *entry;
898 register HE **oentry;
899 register I32 i = 1;
900 I32 found = 0;
901
902 /* what follows is the moral equivalent of:
903
904 if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
905 hv_store(strtab, str, len, Nullsv, hash);
906 */
907 xhv = (XPVHV*)SvANY(strtab);
908 /* assert(xhv_array != 0) */
909 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
910 for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
911 if (HeHASH(entry) != hash) /* strings can't be equal */
912 continue;
913 if (HeKLEN(entry) != len)
914 continue;
cd1469e6 915 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
916 continue;
917 found = 1;
918 break;
919 }
920 if (!found) {
921 entry = new_he();
922 HeKLEN(entry) = len;
923 HeKEY(entry) = savepvn(str,len);
924 HeVAL(entry) = Nullsv;
925 HeHASH(entry) = hash;
926 HeNEXT(entry) = *oentry;
927 *oentry = entry;
928 xhv->xhv_keys++;
929 if (i) { /* initial entry? */
930 ++xhv->xhv_fill;
931 if (xhv->xhv_keys > xhv->xhv_max)
932 hsplit(strtab);
933 }
934 }
935
936 ++HeVAL(entry); /* use value slot as REFCNT */
937 return HeKEY(entry);
938}
939
940/* possibly free a shared string if no one has access to it
941 * len and hash must both be valid for str.
942 */
943void
944unsharepvn(str, len, hash)
945char *str;
946I32 len;
947register U32 hash;
948{
949 register XPVHV* xhv;
950 register HE *entry;
951 register HE **oentry;
952 register I32 i = 1;
953 I32 found = 0;
954
955 /* what follows is the moral equivalent of:
956 if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
957 if (--*Svp == Nullsv)
958 hv_delete(strtab, str, len, G_DISCARD, hash);
959 } */
960 xhv = (XPVHV*)SvANY(strtab);
961 /* assert(xhv_array != 0) */
962 oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
963 for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
964 if (HeHASH(entry) != hash) /* strings can't be equal */
965 continue;
966 if (HeKLEN(entry) != len)
967 continue;
cd1469e6 968 if (memcmp(HeKEY(entry),str,len)) /* is this it? */
fde52b5c
PP
969 continue;
970 found = 1;
971 if (--HeVAL(entry) == Nullsv) {
972 *oentry = HeNEXT(entry);
973 if (i && !*oentry)
974 xhv->xhv_fill--;
975 Safefree(HeKEY(entry));
976 del_he(entry);
977 --xhv->xhv_keys;
978 }
979 break;
980 }
981
982 if (!found)
983 warn("Attempt to free non-existent shared string");
984}
985