perl 5.003_07: MANIFEST
[perl.git] / hv.c
1 /*    hv.c
2  *
3  *    Copyright (c) 1991-1994, Larry Wall
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  *
8  */
9
10 /*
11  * "I sit beside the fire and think of all that I have seen."  --Bilbo
12  */
13
14 #include "EXTERN.h"
15 #include "perl.h"
16
17 static void hsplit _((HV *hv));
18 static void hfreeentries _((HV *hv));
19
20 static HE* more_he();
21
22 static HE*
23 new_he()
24 {
25     HE* he;
26     if (he_root) {
27         he = he_root;
28         he_root = HeNEXT(he);
29         return he;
30     }
31     return more_he();
32 }
33
34 static void
35 del_he(p)
36 HE* p;
37 {
38     HeNEXT(p) = (HE*)he_root;
39     he_root = p;
40 }
41
42 static HE*
43 more_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) {
51         HeNEXT(he) = (HE*)(he + 1);
52         he++;
53     }
54     HeNEXT(he) = 0;
55     return new_he();
56 }
57
58 /* (klen == HEf_SVKEY) is special for MAGICAL hv entries, meaning key slot
59  * contains an SV* */
60
61 SV**
62 hv_fetch(hv,key,klen,lval)
63 HV *hv;
64 char *key;
65 U32 klen;
66 I32 lval;
67 {
68     register XPVHV* xhv;
69     register U32 hash;
70     register HE *entry;
71     SV *sv;
72
73     if (!hv)
74         return 0;
75
76     if (SvRMAGICAL(hv)) {
77         if (mg_find((SV*)hv,'P')) {
78             sv = sv_newmortal();
79             mg_copy((SV*)hv, sv, key, klen);
80             Sv = sv;
81             return &Sv;
82         }
83     }
84
85     xhv = (XPVHV*)SvANY(hv);
86     if (!xhv->xhv_array) {
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                                                                   )
92             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
93         else
94             return 0;
95     }
96
97     PERL_HASH(hash, key, klen);
98
99     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
100     for (; entry; entry = HeNEXT(entry)) {
101         if (HeHASH(entry) != hash)              /* strings can't be equal */
102             continue;
103         if (HeKLEN(entry) != klen)
104             continue;
105         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
106             continue;
107         return &HeVAL(entry);
108     }
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
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
127 /* returns a HE * structure with the all fields set */
128 /* note that hent_val will be a mortal sv for MAGICAL hashes */
129 HE *
130 hv_fetch_ent(hv,keysv,lval,hash)
131 HV *hv;
132 SV *keysv;
133 I32 lval;
134 register 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     if (SvRMAGICAL(hv) && mg_find((SV*)hv,'P')) {
146         sv = sv_newmortal();
147         keysv = sv_2mortal(newSVsv(keysv));
148         mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
149         entry = &He;
150         HeVAL(entry) = sv;
151         HeKEY(entry) = (char*)keysv;
152         HeKLEN(entry) = HEf_SVKEY;              /* hent_key is holding an SV* */
153         return entry;
154     }
155
156     xhv = (XPVHV*)SvANY(hv);
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
168     key = SvPV(keysv, klen);
169     
170     if (!hash)
171         PERL_HASH(hash, key, klen);
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;
179         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
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
201 SV**
202 hv_store(hv,key,klen,val,hash)
203 HV *hv;
204 char *key;
205 U32 klen;
206 SV *val;
207 register U32 hash;
208 {
209     register XPVHV* xhv;
210     register I32 i;
211     register HE *entry;
212     register HE **oentry;
213
214     if (!hv)
215         return 0;
216
217     xhv = (XPVHV*)SvANY(hv);
218     if (SvMAGICAL(hv)) {
219         mg_copy((SV*)hv, val, key, klen);
220 #ifndef OVERLOAD
221         if (!xhv->xhv_array)
222             return 0;
223 #else
224         if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
225                                 || SvMAGIC(hv)->mg_moremagic))
226           return 0;
227 #endif /* OVERLOAD */
228     }
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;
243         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
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);
266     }
267
268     return &HeVAL(entry);
269 }
270
271 HE *
272 hv_store_ent(hv,keysv,val,hash)
273 HV *hv;
274 SV *keysv;
275 SV *val;
276 register 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         keysv = sv_2mortal(newSVsv(keysv));
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
307     if (!xhv->xhv_array)
308         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
309
310     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
311     i = 1;
312
313     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
314         if (HeHASH(entry) != hash)              /* strings can't be equal */
315             continue;
316         if (HeKLEN(entry) != klen)
317             continue;
318         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
319             continue;
320         SvREFCNT_dec(HeVAL(entry));
321         HeVAL(entry) = val;
322         return entry;
323     }
324
325     entry = new_he();
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;
334     *oentry = entry;
335
336     xhv->xhv_keys++;
337     if (i) {                            /* initial entry? */
338         ++xhv->xhv_fill;
339         if (xhv->xhv_keys > xhv->xhv_max)
340             hsplit(hv);
341     }
342
343     return entry;
344 }
345
346 SV *
347 hv_delete(hv,key,klen,flags)
348 HV *hv;
349 char *key;
350 U32 klen;
351 I32 flags;
352 {
353     register XPVHV* xhv;
354     register I32 i;
355     register U32 hash;
356     register HE *entry;
357     register HE **oentry;
358     SV *sv;
359
360     if (!hv)
361         return Nullsv;
362     if (SvRMAGICAL(hv)) {
363         sv = *hv_fetch(hv, key, klen, TRUE);
364         mg_clear(sv);
365         if (mg_find(sv, 's')) {
366             return Nullsv;              /* %SIG elements cannot be deleted */
367         }
368         if (mg_find(sv, 'p')) {
369             sv_unmagic(sv, 'p');        /* No longer an element */
370             return sv;
371         }
372     }
373     xhv = (XPVHV*)SvANY(hv);
374     if (!xhv->xhv_array)
375         return Nullsv;
376
377     PERL_HASH(hash, key, klen);
378
379     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
380     entry = *oentry;
381     i = 1;
382     for (; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
383         if (HeHASH(entry) != hash)              /* strings can't be equal */
384             continue;
385         if (HeKLEN(entry) != klen)
386             continue;
387         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
388             continue;
389         *oentry = HeNEXT(entry);
390         if (i && !*oentry)
391             xhv->xhv_fill--;
392         if (flags & G_DISCARD)
393             sv = Nullsv;
394         else
395             sv = sv_mortalcopy(HeVAL(entry));
396         if (entry == xhv->xhv_eiter)
397             HvLAZYDEL_on(hv);
398         else
399             he_free(entry, HvSHAREKEYS(hv));
400         --xhv->xhv_keys;
401         return sv;
402     }
403     return Nullsv;
404 }
405
406 SV *
407 hv_delete_ent(hv,keysv,flags,hash)
408 HV *hv;
409 SV *keysv;
410 I32 flags;
411 U32 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;
449         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
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             HvLAZYDEL_on(hv);
460         else
461             he_free(entry, HvSHAREKEYS(hv));
462         --xhv->xhv_keys;
463         return sv;
464     }
465     return Nullsv;
466 }
467
468 bool
469 hv_exists(hv,key,klen)
470 HV *hv;
471 char *key;
472 U32 klen;
473 {
474     register XPVHV* xhv;
475     register U32 hash;
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
495     PERL_HASH(hash, key, klen);
496
497     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
498     for (; entry; entry = HeNEXT(entry)) {
499         if (HeHASH(entry) != hash)              /* strings can't be equal */
500             continue;
501         if (HeKLEN(entry) != klen)
502             continue;
503         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
504             continue;
505         return TRUE;
506     }
507     return FALSE;
508 }
509
510
511 bool
512 hv_exists_ent(hv,keysv,hash)
513 HV *hv;
514 SV *keysv;
515 U32 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();
529             keysv = sv_2mortal(newSVsv(keysv));
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;
550         if (memcmp(HeKEY(entry),key,klen))      /* is this it? */
551             continue;
552         return TRUE;
553     }
554     return FALSE;
555 }
556
557 static void
558 hsplit(hv)
559 HV *hv;
560 {
561     register XPVHV* xhv = (XPVHV*)SvANY(hv);
562     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
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;
569 #ifndef STRANGE_MALLOC
570     I32 tmp;
571 #endif
572
573     a = (HE**)xhv->xhv_array;
574     nomemok = TRUE;
575 #ifdef STRANGE_MALLOC
576     Renew(a, newsize, HE*);
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*);
588     if (oldsize >= 64 && !nice_chunk) {
589         nice_chunk = (char*)xhv->xhv_array;
590         nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
591     }
592     else
593         Safefree(xhv->xhv_array);
594 #endif
595
596     nomemok = FALSE;
597     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
598     xhv->xhv_max = --newsize;
599     xhv->xhv_array = (char*)a;
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) {
606             if ((HeHASH(entry) & newsize) != i) {
607                 *oentry = HeNEXT(entry);
608                 HeNEXT(entry) = *b;
609                 if (!*b)
610                     xhv->xhv_fill++;
611                 *b = entry;
612                 continue;
613             }
614             else
615                 oentry = &HeNEXT(entry);
616         }
617         if (!*a)                                /* everything moved */
618             xhv->xhv_fill--;
619     }
620 }
621
622 void
623 hv_ksplit(hv, newmax)
624 HV *hv;
625 IV 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
700 HV *
701 newHV()
702 {
703     register HV *hv;
704     register XPVHV* xhv;
705
706     hv = (HV*)NEWSV(502,0);
707     sv_upgrade((SV *)hv, SVt_PVHV);
708     xhv = (XPVHV*)SvANY(hv);
709     SvPOK_off(hv);
710     SvNOK_off(hv);
711 #ifndef NODEFAULT_SHAREKEYS    
712     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
713 #endif    
714     xhv->xhv_max = 7;           /* start with 8 buckets */
715     xhv->xhv_fill = 0;
716     xhv->xhv_pmroot = 0;
717     (void)hv_iterinit(hv);      /* so each() will start off right */
718     return hv;
719 }
720
721 void
722 he_free(hent, shared)
723 register HE *hent;
724 I32 shared;
725 {
726     if (!hent)
727         return;
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));
735     del_he(hent);
736 }
737
738 void
739 he_delayfree(hent, shared)
740 register HE *hent;
741 I32 shared;
742 {
743     if (!hent)
744         return;
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));
752     del_he(hent);
753 }
754
755 void
756 hv_clear(hv)
757 HV *hv;
758 {
759     register XPVHV* xhv;
760     if (!hv)
761         return;
762     xhv = (XPVHV*)SvANY(hv);
763     hfreeentries(hv);
764     xhv->xhv_fill = 0;
765     xhv->xhv_keys = 0;
766     if (xhv->xhv_array)
767         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
768
769     if (SvRMAGICAL(hv))
770         mg_clear((SV*)hv); 
771 }
772
773 static void
774 hfreeentries(hv)
775 HV *hv;
776 {
777     register HE **array;
778     register HE *hent;
779     register HE *ohent = Null(HE*);
780     I32 riter;
781     I32 max;
782     I32 shared;
783
784     if (!hv)
785         return;
786     if (!HvARRAY(hv))
787         return;
788
789     riter = 0;
790     max = HvMAX(hv);
791     array = HvARRAY(hv);
792     hent = array[0];
793     shared = HvSHAREKEYS(hv);
794     for (;;) {
795         if (hent) {
796             ohent = hent;
797             hent = HeNEXT(hent);
798             he_free(ohent, shared);
799         }
800         if (!hent) {
801             if (++riter > max)
802                 break;
803             hent = array[riter];
804         } 
805     }
806     (void)hv_iterinit(hv);
807 }
808
809 void
810 hv_undef(hv)
811 HV *hv;
812 {
813     register XPVHV* xhv;
814     if (!hv)
815         return;
816     xhv = (XPVHV*)SvANY(hv);
817     hfreeentries(hv);
818     Safefree(xhv->xhv_array);
819     if (HvNAME(hv)) {
820         Safefree(HvNAME(hv));
821         HvNAME(hv) = 0;
822     }
823     xhv->xhv_array = 0;
824     xhv->xhv_max = 7;           /* it's a normal associative array */
825     xhv->xhv_fill = 0;
826     xhv->xhv_keys = 0;
827
828     if (SvRMAGICAL(hv))
829         mg_clear((SV*)hv); 
830 }
831
832 I32
833 hv_iterinit(hv)
834 HV *hv;
835 {
836     register XPVHV* xhv = (XPVHV*)SvANY(hv);
837     HE *entry = xhv->xhv_eiter;
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
841     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
842         HvLAZYDEL_off(hv);
843         he_free(entry, HvSHAREKEYS(hv));
844     }
845     xhv->xhv_riter = -1;
846     xhv->xhv_eiter = Null(HE*);
847     return xhv->xhv_fill;
848 }
849
850 HE *
851 hv_iternext(hv)
852 HV *hv;
853 {
854     register XPVHV* xhv;
855     register HE *entry;
856     HE *oldentry;
857     MAGIC* mg;
858
859     if (!hv)
860         croak("Bad associative array");
861     xhv = (XPVHV*)SvANY(hv);
862     oldentry = entry = xhv->xhv_eiter;
863
864     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
865         SV *key = sv_newmortal();
866         if (entry) {
867             sv_setsv(key, HeSVKEY_force(entry));
868             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
869         }
870         else {
871             xhv->xhv_eiter = entry = new_he();  /* only one HE per MAGICAL hash */
872             Zero(entry, 1, HE);
873             HeKLEN(entry) = HEf_SVKEY;
874         }
875         magic_nextpack((SV*) hv,mg,key);
876         if (SvOK(key)) {
877             /* force key to stay around until next time */
878             HeKEY(entry) = (char*)SvREFCNT_inc(key);
879             return entry;                       /* beware, hent_val is not set */
880         }
881         if (HeVAL(entry))
882             SvREFCNT_dec(HeVAL(entry));
883         del_he(entry);
884         xhv->xhv_eiter = Null(HE*);
885         return Null(HE*);
886     }
887
888     if (!xhv->xhv_array)
889         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
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;
897         }
898         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
899     }
900
901     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
902         HvLAZYDEL_off(hv);
903         he_free(oldentry, HvSHAREKEYS(hv));
904     }
905
906     xhv->xhv_eiter = entry;
907     return entry;
908 }
909
910 char *
911 hv_iterkey(entry,retlen)
912 register HE *entry;
913 I32 *retlen;
914 {
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 */
925 SV *
926 hv_iterkeysv(entry)
927 register 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)));
934 }
935
936 SV *
937 hv_iterval(hv,entry)
938 HV *hv;
939 register HE *entry;
940 {
941     if (SvRMAGICAL(hv)) {
942         if (mg_find((SV*)hv,'P')) {
943             SV* sv = sv_newmortal();
944             mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
945             return sv;
946         }
947     }
948     return HeVAL(entry);
949 }
950
951 SV *
952 hv_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
964 void
965 hv_magic(hv, gv, how)
966 HV* hv;
967 GV* gv;
968 int how;
969 {
970     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
971 }
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  */
977 char *
978 sharepvn(str, len, hash)
979 char *str;
980 I32 len;
981 register 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;
1002         if (memcmp(HeKEY(entry),str,len))               /* is this it? */
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  */
1030 void
1031 unsharepvn(str, len, hash)
1032 char *str;
1033 I32 len;
1034 register 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;
1055         if (memcmp(HeKEY(entry),str,len))               /* is this it? */
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