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