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