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