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