This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
simplify xhv_array sizing
[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 HE **a = (HE**)xhv->xhv_array;
669     register HE **b;
670     register HE *entry;
671     register HE **oentry;
672
673     nomemok = TRUE;
674 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
675     Renew(a, newsize, HE*);
676     if (!a) {
677       nomemok = FALSE;
678       return;
679     }
680 #else
681 #define MALLOC_OVERHEAD 16
682     New(2, a, newsize*sizeof(HE*) * 2 - MALLOC_OVERHEAD, char);
683     if (!a) {
684       nomemok = FALSE;
685       return;
686     }
687     Copy(xhv->xhv_array, a, oldsize, HE*);
688     if (oldsize >= 64) {
689         offer_nice_chunk(xhv->xhv_array,
690                          oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
691     }
692     else
693         Safefree(xhv->xhv_array);
694 #endif
695
696     nomemok = FALSE;
697     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
698     xhv->xhv_max = --newsize;
699     xhv->xhv_array = (char*)a;
700
701     for (i=0; i<oldsize; i++,a++) {
702         if (!*a)                                /* non-existent */
703             continue;
704         b = a+oldsize;
705         for (oentry = a, entry = *a; entry; entry = *oentry) {
706             if ((HeHASH(entry) & newsize) != i) {
707                 *oentry = HeNEXT(entry);
708                 HeNEXT(entry) = *b;
709                 if (!*b)
710                     xhv->xhv_fill++;
711                 *b = entry;
712                 continue;
713             }
714             else
715                 oentry = &HeNEXT(entry);
716         }
717         if (!*a)                                /* everything moved */
718             xhv->xhv_fill--;
719     }
720 }
721
722 void
723 hv_ksplit(HV *hv, IV newmax)
724 {
725     register XPVHV* xhv = (XPVHV*)SvANY(hv);
726     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
727     register I32 newsize;
728     register I32 i;
729     register I32 j;
730     register HE **a;
731     register HE *entry;
732     register HE **oentry;
733
734     newsize = (I32) newmax;                     /* possible truncation here */
735     if (newsize != newmax || newmax <= oldsize)
736         return;
737     while ((newsize & (1 + ~newsize)) != newsize) {
738         newsize &= ~(newsize & (1 + ~newsize)); /* get proper power of 2 */
739     }
740     if (newsize < newmax)
741         newsize *= 2;
742     if (newsize < newmax)
743         return;                                 /* overflow detection */
744
745     a = (HE**)xhv->xhv_array;
746     if (a) {
747         nomemok = TRUE;
748 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
749         Renew(a, newsize, HE*);
750         if (!a) {
751           nomemok = FALSE;
752           return;
753         }
754 #else
755         New(2, a, newsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD, char);
756         if (!a) {
757           nomemok = FALSE;
758           return;
759         }
760         Copy(xhv->xhv_array, a, oldsize, HE*);
761         if (oldsize >= 64) {
762             offer_nice_chunk(xhv->xhv_array,
763                              oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD);
764         }
765         else
766             Safefree(xhv->xhv_array);
767 #endif
768         nomemok = FALSE;
769         Zero(&a[oldsize], newsize-oldsize, HE*); /* zero 2nd half*/
770     }
771     else {
772 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
773         Newz(0, a, newsize, HE*);
774 #else
775         Newz(0, a, newsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD, char);
776 #endif
777     }
778     xhv->xhv_max = --newsize;
779     xhv->xhv_array = (char*)a;
780     if (!xhv->xhv_fill)                         /* skip rest if no entries */
781         return;
782
783     for (i=0; i<oldsize; i++,a++) {
784         if (!*a)                                /* non-existent */
785             continue;
786         for (oentry = a, entry = *a; entry; entry = *oentry) {
787             if ((j = (HeHASH(entry) & newsize)) != i) {
788                 j -= i;
789                 *oentry = HeNEXT(entry);
790                 if (!(HeNEXT(entry) = a[j]))
791                     xhv->xhv_fill++;
792                 a[j] = entry;
793                 continue;
794             }
795             else
796                 oentry = &HeNEXT(entry);
797         }
798         if (!*a)                                /* everything moved */
799             xhv->xhv_fill--;
800     }
801 }
802
803 HV *
804 newHV(void)
805 {
806     register HV *hv;
807     register XPVHV* xhv;
808
809     hv = (HV*)NEWSV(502,0);
810     sv_upgrade((SV *)hv, SVt_PVHV);
811     xhv = (XPVHV*)SvANY(hv);
812     SvPOK_off(hv);
813     SvNOK_off(hv);
814 #ifndef NODEFAULT_SHAREKEYS    
815     HvSHAREKEYS_on(hv);         /* key-sharing on by default */
816 #endif    
817     xhv->xhv_max = 7;           /* start with 8 buckets */
818     xhv->xhv_fill = 0;
819     xhv->xhv_pmroot = 0;
820     (void)hv_iterinit(hv);      /* so each() will start off right */
821     return hv;
822 }
823
824 HV *
825 newHVhv(HV *ohv)
826 {
827     register HV *hv;
828     register XPVHV* xhv;
829     STRLEN hv_max = ohv ? HvMAX(ohv) : 0;
830     STRLEN hv_fill = ohv ? HvFILL(ohv) : 0;
831
832     hv = newHV();
833     while (hv_max && hv_max + 1 >= hv_fill * 2)
834         hv_max = hv_max / 2;    /* Is always 2^n-1 */
835     ((XPVHV*)SvANY(hv))->xhv_max = hv_max;
836     if (!hv_fill)
837         return hv;
838
839 #if 0
840     if (!SvRMAGICAL(ohv) || !mg_find((SV*)ohv,'P')) {
841         /* Quick way ???*/
842     } 
843     else 
844 #endif
845     {
846         HE *entry;
847         I32 hv_riter = HvRITER(ohv);    /* current root of iterator */
848         HE *hv_eiter = HvEITER(ohv);    /* current entry of iterator */
849         
850         /* Slow way */
851         hv_iterinit(hv);
852         while (entry = hv_iternext(ohv)) {
853             hv_store(hv, HeKEY(entry), HeKLEN(entry), 
854                      SvREFCNT_inc(HeVAL(entry)), HeHASH(entry));
855         }
856         HvRITER(ohv) = hv_riter;
857         HvEITER(ohv) = hv_eiter;
858     }
859     
860     return hv;
861 }
862
863 void
864 hv_free_ent(HV *hv, register HE *entry)
865 {
866     SV *val;
867
868     if (!entry)
869         return;
870     val = HeVAL(entry);
871     if (val && isGV(val) && GvCVu(val) && HvNAME(hv))
872         sub_generation++;       /* may be deletion of method from stash */
873     SvREFCNT_dec(val);
874     if (HeKLEN(entry) == HEf_SVKEY) {
875         SvREFCNT_dec(HeKEY_sv(entry));
876         Safefree(HeKEY_hek(entry));
877     }
878     else if (HvSHAREKEYS(hv))
879         unshare_hek(HeKEY_hek(entry));
880     else
881         Safefree(HeKEY_hek(entry));
882     del_he(entry);
883 }
884
885 void
886 hv_delayfree_ent(HV *hv, register HE *entry)
887 {
888     if (!entry)
889         return;
890     if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME(hv))
891         sub_generation++;       /* may be deletion of method from stash */
892     sv_2mortal(HeVAL(entry));   /* free between statements */
893     if (HeKLEN(entry) == HEf_SVKEY) {
894         sv_2mortal(HeKEY_sv(entry));
895         Safefree(HeKEY_hek(entry));
896     }
897     else if (HvSHAREKEYS(hv))
898         unshare_hek(HeKEY_hek(entry));
899     else
900         Safefree(HeKEY_hek(entry));
901     del_he(entry);
902 }
903
904 void
905 hv_clear(HV *hv)
906 {
907     register XPVHV* xhv;
908     if (!hv)
909         return;
910     xhv = (XPVHV*)SvANY(hv);
911     hfreeentries(hv);
912     xhv->xhv_fill = 0;
913     xhv->xhv_keys = 0;
914     if (xhv->xhv_array)
915         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
916
917     if (SvRMAGICAL(hv))
918         mg_clear((SV*)hv); 
919 }
920
921 STATIC void
922 hfreeentries(HV *hv)
923 {
924     register HE **array;
925     register HE *entry;
926     register HE *oentry = Null(HE*);
927     I32 riter;
928     I32 max;
929
930     if (!hv)
931         return;
932     if (!HvARRAY(hv))
933         return;
934
935     riter = 0;
936     max = HvMAX(hv);
937     array = HvARRAY(hv);
938     entry = array[0];
939     for (;;) {
940         if (entry) {
941             oentry = entry;
942             entry = HeNEXT(entry);
943             hv_free_ent(hv, oentry);
944         }
945         if (!entry) {
946             if (++riter > max)
947                 break;
948             entry = array[riter];
949         } 
950     }
951     (void)hv_iterinit(hv);
952 }
953
954 void
955 hv_undef(HV *hv)
956 {
957     register XPVHV* xhv;
958     if (!hv)
959         return;
960     xhv = (XPVHV*)SvANY(hv);
961     hfreeentries(hv);
962     Safefree(xhv->xhv_array);
963     if (HvNAME(hv)) {
964         Safefree(HvNAME(hv));
965         HvNAME(hv) = 0;
966     }
967     xhv->xhv_array = 0;
968     xhv->xhv_max = 7;           /* it's a normal hash */
969     xhv->xhv_fill = 0;
970     xhv->xhv_keys = 0;
971
972     if (SvRMAGICAL(hv))
973         mg_clear((SV*)hv); 
974 }
975
976 I32
977 hv_iterinit(HV *hv)
978 {
979     register XPVHV* xhv;
980     HE *entry;
981
982     if (!hv)
983         croak("Bad hash");
984     xhv = (XPVHV*)SvANY(hv);
985     entry = xhv->xhv_eiter;
986 #ifdef DYNAMIC_ENV_FETCH  /* set up %ENV for iteration */
987     if (HvNAME(hv) && strEQ(HvNAME(hv), ENV_HV_NAME))
988         prime_env_iter();
989 #endif
990     if (entry && HvLAZYDEL(hv)) {       /* was deleted earlier? */
991         HvLAZYDEL_off(hv);
992         hv_free_ent(hv, entry);
993     }
994     xhv->xhv_riter = -1;
995     xhv->xhv_eiter = Null(HE*);
996     return xhv->xhv_keys;       /* used to be xhv->xhv_fill before 5.004_65 */
997 }
998
999 HE *
1000 hv_iternext(HV *hv)
1001 {
1002     register XPVHV* xhv;
1003     register HE *entry;
1004     HE *oldentry;
1005     MAGIC* mg;
1006
1007     if (!hv)
1008         croak("Bad hash");
1009     xhv = (XPVHV*)SvANY(hv);
1010     oldentry = entry = xhv->xhv_eiter;
1011
1012     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
1013         SV *key = sv_newmortal();
1014         if (entry) {
1015             sv_setsv(key, HeSVKEY_force(entry));
1016             SvREFCNT_dec(HeSVKEY(entry));       /* get rid of previous key */
1017         }
1018         else {
1019             char *k;
1020             HEK *hek;
1021
1022             xhv->xhv_eiter = entry = new_he();  /* one HE per MAGICAL hash */
1023             Zero(entry, 1, HE);
1024             Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
1025             hek = (HEK*)k;
1026             HeKEY_hek(entry) = hek;
1027             HeKLEN(entry) = HEf_SVKEY;
1028         }
1029         magic_nextpack((SV*) hv,mg,key);
1030         if (SvOK(key)) {
1031             /* force key to stay around until next time */
1032             HeSVKEY_set(entry, SvREFCNT_inc(key));
1033             return entry;               /* beware, hent_val is not set */
1034         }
1035         if (HeVAL(entry))
1036             SvREFCNT_dec(HeVAL(entry));
1037         Safefree(HeKEY_hek(entry));
1038         del_he(entry);
1039         xhv->xhv_eiter = Null(HE*);
1040         return Null(HE*);
1041     }
1042
1043     if (!xhv->xhv_array)
1044         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
1045     if (entry)
1046         entry = HeNEXT(entry);
1047     while (!entry) {
1048         ++xhv->xhv_riter;
1049         if (xhv->xhv_riter > xhv->xhv_max) {
1050             xhv->xhv_riter = -1;
1051             break;
1052         }
1053         entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
1054     }
1055
1056     if (oldentry && HvLAZYDEL(hv)) {            /* was deleted earlier? */
1057         HvLAZYDEL_off(hv);
1058         hv_free_ent(hv, oldentry);
1059     }
1060
1061     xhv->xhv_eiter = entry;
1062     return entry;
1063 }
1064
1065 char *
1066 hv_iterkey(register HE *entry, I32 *retlen)
1067 {
1068     if (HeKLEN(entry) == HEf_SVKEY) {
1069         STRLEN len;
1070         char *p = SvPV(HeKEY_sv(entry), len);
1071         *retlen = len;
1072         return p;
1073     }
1074     else {
1075         *retlen = HeKLEN(entry);
1076         return HeKEY(entry);
1077     }
1078 }
1079
1080 /* unlike hv_iterval(), this always returns a mortal copy of the key */
1081 SV *
1082 hv_iterkeysv(register HE *entry)
1083 {
1084     if (HeKLEN(entry) == HEf_SVKEY)
1085         return sv_mortalcopy(HeKEY_sv(entry));
1086     else
1087         return sv_2mortal(newSVpv((HeKLEN(entry) ? HeKEY(entry) : ""),
1088                                   HeKLEN(entry)));
1089 }
1090
1091 SV *
1092 hv_iterval(HV *hv, register HE *entry)
1093 {
1094     if (SvRMAGICAL(hv)) {
1095         if (mg_find((SV*)hv,'P')) {
1096             SV* sv = sv_newmortal();
1097             if (HeKLEN(entry) == HEf_SVKEY)
1098                 mg_copy((SV*)hv, sv, (char*)HeKEY_sv(entry), HEf_SVKEY);
1099             else mg_copy((SV*)hv, sv, HeKEY(entry), HeKLEN(entry));
1100             return sv;
1101         }
1102     }
1103     return HeVAL(entry);
1104 }
1105
1106 SV *
1107 hv_iternextsv(HV *hv, char **key, I32 *retlen)
1108 {
1109     HE *he;
1110     if ( (he = hv_iternext(hv)) == NULL)
1111         return NULL;
1112     *key = hv_iterkey(he, retlen);
1113     return hv_iterval(hv, he);
1114 }
1115
1116 void
1117 hv_magic(HV *hv, GV *gv, int how)
1118 {
1119     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
1120 }
1121
1122 char*   
1123 sharepvn(char *sv, I32 len, U32 hash)
1124 {
1125     return HEK_KEY(share_hek(sv, len, hash));
1126 }
1127
1128 /* possibly free a shared string if no one has access to it
1129  * len and hash must both be valid for str.
1130  */
1131 void
1132 unsharepvn(char *str, I32 len, U32 hash)
1133 {
1134     register XPVHV* xhv;
1135     register HE *entry;
1136     register HE **oentry;
1137     register I32 i = 1;
1138     I32 found = 0;
1139     
1140     /* what follows is the moral equivalent of:
1141     if ((Svp = hv_fetch(strtab, tmpsv, FALSE, hash))) {
1142         if (--*Svp == Nullsv)
1143             hv_delete(strtab, str, len, G_DISCARD, hash);
1144     } */
1145     xhv = (XPVHV*)SvANY(strtab);
1146     /* assert(xhv_array != 0) */
1147     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1148     for (entry = *oentry; entry; i=0, oentry = &HeNEXT(entry), entry = *oentry) {
1149         if (HeHASH(entry) != hash)              /* strings can't be equal */
1150             continue;
1151         if (HeKLEN(entry) != len)
1152             continue;
1153         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1154             continue;
1155         found = 1;
1156         if (--HeVAL(entry) == Nullsv) {
1157             *oentry = HeNEXT(entry);
1158             if (i && !*oentry)
1159                 xhv->xhv_fill--;
1160             Safefree(HeKEY_hek(entry));
1161             del_he(entry);
1162             --xhv->xhv_keys;
1163         }
1164         break;
1165     }
1166     
1167     if (!found)
1168         warn("Attempt to free non-existent shared string");    
1169 }
1170
1171 /* get a (constant) string ptr from the global string table
1172  * string will get added if it is not already there.
1173  * len and hash must both be valid for str.
1174  */
1175 HEK *
1176 share_hek(char *str, I32 len, register U32 hash)
1177 {
1178     register XPVHV* xhv;
1179     register HE *entry;
1180     register HE **oentry;
1181     register I32 i = 1;
1182     I32 found = 0;
1183
1184     /* what follows is the moral equivalent of:
1185        
1186     if (!(Svp = hv_fetch(strtab, str, len, FALSE)))
1187         hv_store(strtab, str, len, Nullsv, hash);
1188     */
1189     xhv = (XPVHV*)SvANY(strtab);
1190     /* assert(xhv_array != 0) */
1191     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
1192     for (entry = *oentry; entry; i=0, entry = HeNEXT(entry)) {
1193         if (HeHASH(entry) != hash)              /* strings can't be equal */
1194             continue;
1195         if (HeKLEN(entry) != len)
1196             continue;
1197         if (memNE(HeKEY(entry),str,len))        /* is this it? */
1198             continue;
1199         found = 1;
1200         break;
1201     }
1202     if (!found) {
1203         entry = new_he();
1204         HeKEY_hek(entry) = save_hek(str, len, hash);
1205         HeVAL(entry) = Nullsv;
1206         HeNEXT(entry) = *oentry;
1207         *oentry = entry;
1208         xhv->xhv_keys++;
1209         if (i) {                                /* initial entry? */
1210             ++xhv->xhv_fill;
1211             if (xhv->xhv_keys > xhv->xhv_max)
1212                 hsplit(strtab);
1213         }
1214     }
1215
1216     ++HeVAL(entry);                             /* use value slot as REFCNT */
1217     return HeKEY_hek(entry);
1218 }
1219
1220
1221