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