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