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