perl5.002beta3
[perl.git] / hv.c
1 /*    hv.c
2  *
3  *    Copyright (c) 1991-1994, Larry Wall
4  *
5  *    You may distribute under the terms of either the GNU General Public
6  *    License or the Artistic License, as specified in the README file.
7  *
8  */
9
10 /*
11  * "I sit beside the fire and think of all that I have seen."  --Bilbo
12  */
13
14 #include "EXTERN.h"
15 #include "perl.h"
16
17 static void hsplit _((HV *hv));
18 static void hfreeentries _((HV *hv));
19
20 static HE* more_he();
21
22 static HE*
23 new_he()
24 {
25     HE* he;
26     if (he_root) {
27         he = he_root;
28         he_root = (HE*)he->hent_next;
29         return he;
30     }
31     return more_he();
32 }
33
34 static void
35 del_he(p)
36 HE* p;
37 {
38     p->hent_next = (HE*)he_root;
39     he_root = p;
40 }
41
42 static HE*
43 more_he()
44 {
45     register HE* he;
46     register HE* heend;
47     he_root = (HE*)safemalloc(1008);
48     he = he_root;
49     heend = &he[1008 / sizeof(HE) - 1];
50     while (he < heend) {
51         he->hent_next = (HE*)(he + 1);
52         he++;
53     }
54     he->hent_next = 0;
55     return new_he();
56 }
57
58 SV**
59 hv_fetch(hv,key,klen,lval)
60 HV *hv;
61 char *key;
62 U32 klen;
63 I32 lval;
64 {
65     register XPVHV* xhv;
66     register char *s;
67     register I32 i;
68     register I32 hash;
69     register HE *entry;
70     SV *sv;
71
72     if (!hv)
73         return 0;
74
75     if (SvRMAGICAL(hv)) {
76         if (mg_find((SV*)hv,'P')) {
77             sv = sv_newmortal();
78             mg_copy((SV*)hv, sv, key, klen);
79             Sv = sv;
80             return &Sv;
81         }
82     }
83
84     xhv = (XPVHV*)SvANY(hv);
85     if (!xhv->xhv_array) {
86         if (lval 
87 #ifdef DYNAMIC_ENV_FETCH  /* if it's an %ENV lookup, we may get it on the fly */
88                  || (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME))
89 #endif
90                                                                   )
91             Newz(503,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
92         else
93             return 0;
94     }
95
96     i = klen;
97     hash = 0;
98     s = key;
99     while (i--)
100         hash = hash * 33 + *s++;
101
102     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
103     for (; entry; entry = entry->hent_next) {
104         if (entry->hent_hash != hash)           /* strings can't be equal */
105             continue;
106         if (entry->hent_klen != klen)
107             continue;
108         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
109             continue;
110         return &entry->hent_val;
111     }
112 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
113     if (HvNAME(hv) && strEQ(HvNAME(hv),ENV_HV_NAME)) {
114       char *gotenv;
115
116       gotenv = my_getenv(key);
117       if (gotenv != NULL) {
118         sv = newSVpv(gotenv,strlen(gotenv));
119         return hv_store(hv,key,klen,sv,hash);
120       }
121     }
122 #endif
123     if (lval) {         /* gonna assign to this, so it better be there */
124         sv = NEWSV(61,0);
125         return hv_store(hv,key,klen,sv,hash);
126     }
127     return 0;
128 }
129
130 SV**
131 hv_store(hv,key,klen,val,hash)
132 HV *hv;
133 char *key;
134 U32 klen;
135 SV *val;
136 register U32 hash;
137 {
138     register XPVHV* xhv;
139     register char *s;
140     register I32 i;
141     register HE *entry;
142     register HE **oentry;
143
144     if (!hv)
145         return 0;
146
147     xhv = (XPVHV*)SvANY(hv);
148     if (SvMAGICAL(hv)) {
149         mg_copy((SV*)hv, val, key, klen);
150 #ifndef OVERLOAD
151         if (!xhv->xhv_array)
152             return 0;
153 #else
154         if (!xhv->xhv_array && (SvMAGIC(hv)->mg_type != 'A'
155                                 || SvMAGIC(hv)->mg_moremagic))
156           return 0;
157 #endif /* OVERLOAD */
158     }
159     if (!hash) {
160     i = klen;
161     s = key;
162     while (i--)
163         hash = hash * 33 + *s++;
164     }
165
166     if (!xhv->xhv_array)
167         Newz(505, xhv->xhv_array, sizeof(HE**) * (xhv->xhv_max + 1), char);
168
169     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
170     i = 1;
171
172     for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
173         if (entry->hent_hash != hash)           /* strings can't be equal */
174             continue;
175         if (entry->hent_klen != klen)
176             continue;
177         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
178             continue;
179         SvREFCNT_dec(entry->hent_val);
180         entry->hent_val = val;
181         return &entry->hent_val;
182     }
183
184     entry = new_he();
185     entry->hent_klen = klen;
186     entry->hent_key = savepvn(key,klen);
187     entry->hent_val = val;
188     entry->hent_hash = hash;
189     entry->hent_next = *oentry;
190     *oentry = entry;
191
192     xhv->xhv_keys++;
193     if (i) {                            /* initial entry? */
194         ++xhv->xhv_fill;
195         if (xhv->xhv_keys > xhv->xhv_max)
196             hsplit(hv);
197     }
198
199     return &entry->hent_val;
200 }
201
202 SV *
203 hv_delete(hv,key,klen,flags)
204 HV *hv;
205 char *key;
206 U32 klen;
207 I32 flags;
208 {
209     register XPVHV* xhv;
210     register char *s;
211     register I32 i;
212     register I32 hash;
213     register HE *entry;
214     register HE **oentry;
215     SV *sv;
216
217     if (!hv)
218         return Nullsv;
219     if (SvRMAGICAL(hv)) {
220         sv = *hv_fetch(hv, key, klen, TRUE);
221         mg_clear(sv);
222         if (mg_find(sv, 'p')) {
223             sv_unmagic(sv, 'p');        /* No longer an element */
224             return sv;
225         }
226     }
227     xhv = (XPVHV*)SvANY(hv);
228     if (!xhv->xhv_array)
229         return Nullsv;
230     i = klen;
231     hash = 0;
232     s = key;
233     while (i--)
234         hash = hash * 33 + *s++;
235
236     oentry = &((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
237     entry = *oentry;
238     i = 1;
239     for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
240         if (entry->hent_hash != hash)           /* strings can't be equal */
241             continue;
242         if (entry->hent_klen != klen)
243             continue;
244         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
245             continue;
246         *oentry = entry->hent_next;
247         if (i && !*oentry)
248             xhv->xhv_fill--;
249         if (flags & G_DISCARD)
250             sv = Nullsv;
251         else
252             sv = sv_mortalcopy(entry->hent_val);
253         if (entry == xhv->xhv_eiter)
254             entry->hent_klen = -1;
255         else
256             he_free(entry);
257         --xhv->xhv_keys;
258         return sv;
259     }
260     return Nullsv;
261 }
262
263 bool
264 hv_exists(hv,key,klen)
265 HV *hv;
266 char *key;
267 U32 klen;
268 {
269     register XPVHV* xhv;
270     register char *s;
271     register I32 i;
272     register I32 hash;
273     register HE *entry;
274     SV *sv;
275
276     if (!hv)
277         return 0;
278
279     if (SvRMAGICAL(hv)) {
280         if (mg_find((SV*)hv,'P')) {
281             sv = sv_newmortal();
282             mg_copy((SV*)hv, sv, key, klen); 
283             magic_existspack(sv, mg_find(sv, 'p'));
284             return SvTRUE(sv);
285         }
286     }
287
288     xhv = (XPVHV*)SvANY(hv);
289     if (!xhv->xhv_array)
290         return 0; 
291
292     i = klen;
293     hash = 0;
294     s = key;
295     while (i--)
296         hash = hash * 33 + *s++;
297
298     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
299     for (; entry; entry = entry->hent_next) {
300         if (entry->hent_hash != hash)           /* strings can't be equal */
301             continue;
302         if (entry->hent_klen != klen)
303             continue;
304         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
305             continue;
306         return TRUE;
307     }
308     return FALSE;
309 }
310
311 static void
312 hsplit(hv)
313 HV *hv;
314 {
315     register XPVHV* xhv = (XPVHV*)SvANY(hv);
316     I32 oldsize = (I32) xhv->xhv_max + 1; /* sic(k) */
317     register I32 newsize = oldsize * 2;
318     register I32 i;
319     register HE **a;
320     register HE **b;
321     register HE *entry;
322     register HE **oentry;
323 #ifndef STRANGE_MALLOC
324     I32 tmp;
325 #endif
326
327     a = (HE**)xhv->xhv_array;
328     nomemok = TRUE;
329 #ifdef STRANGE_MALLOC
330     Renew(a, newsize, HE*);
331 #else
332     i = newsize * sizeof(HE*);
333 #define MALLOC_OVERHEAD 16
334     tmp = MALLOC_OVERHEAD;
335     while (tmp - MALLOC_OVERHEAD < i)
336         tmp += tmp;
337     tmp -= MALLOC_OVERHEAD;
338     tmp /= sizeof(HE*);
339     assert(tmp >= newsize);
340     New(2,a, tmp, HE*);
341     Copy(xhv->xhv_array, a, oldsize, HE*);
342     if (oldsize >= 64 && !nice_chunk) {
343         nice_chunk = (char*)xhv->xhv_array;
344         nice_chunk_size = oldsize * sizeof(HE*) * 2 - MALLOC_OVERHEAD;
345     }
346     else
347         Safefree(xhv->xhv_array);
348 #endif
349
350     nomemok = FALSE;
351     Zero(&a[oldsize], oldsize, HE*);            /* zero 2nd half*/
352     xhv->xhv_max = --newsize;
353     xhv->xhv_array = (char*)a;
354
355     for (i=0; i<oldsize; i++,a++) {
356         if (!*a)                                /* non-existent */
357             continue;
358         b = a+oldsize;
359         for (oentry = a, entry = *a; entry; entry = *oentry) {
360             if ((entry->hent_hash & newsize) != i) {
361                 *oentry = entry->hent_next;
362                 entry->hent_next = *b;
363                 if (!*b)
364                     xhv->xhv_fill++;
365                 *b = entry;
366                 continue;
367             }
368             else
369                 oentry = &entry->hent_next;
370         }
371         if (!*a)                                /* everything moved */
372             xhv->xhv_fill--;
373     }
374 }
375
376 HV *
377 newHV()
378 {
379     register HV *hv;
380     register XPVHV* xhv;
381
382     hv = (HV*)NEWSV(502,0);
383     sv_upgrade((SV *)hv, SVt_PVHV);
384     xhv = (XPVHV*)SvANY(hv);
385     SvPOK_off(hv);
386     SvNOK_off(hv);
387     xhv->xhv_max = 7;           /* start with 8 buckets */
388     xhv->xhv_fill = 0;
389     xhv->xhv_pmroot = 0;
390     (void)hv_iterinit(hv);      /* so each() will start off right */
391     return hv;
392 }
393
394 void
395 he_free(hent)
396 register HE *hent;
397 {
398     if (!hent)
399         return;
400     SvREFCNT_dec(hent->hent_val);
401     Safefree(hent->hent_key);
402     del_he(hent);
403 }
404
405 void
406 he_delayfree(hent)
407 register HE *hent;
408 {
409     if (!hent)
410         return;
411     sv_2mortal(hent->hent_val); /* free between statements */
412     Safefree(hent->hent_key);
413     del_he(hent);
414 }
415
416 void
417 hv_clear(hv)
418 HV *hv;
419 {
420     register XPVHV* xhv;
421     if (!hv)
422         return;
423     xhv = (XPVHV*)SvANY(hv);
424     hfreeentries(hv);
425     xhv->xhv_fill = 0;
426     xhv->xhv_keys = 0;
427     if (xhv->xhv_array)
428         (void)memzero(xhv->xhv_array, (xhv->xhv_max + 1) * sizeof(HE*));
429
430     if (SvRMAGICAL(hv))
431         mg_clear((SV*)hv); 
432 }
433
434 static void
435 hfreeentries(hv)
436 HV *hv;
437 {
438     register HE **array;
439     register HE *hent;
440     register HE *ohent = Null(HE*);
441     I32 riter;
442     I32 max;
443
444     if (!hv)
445         return;
446     if (!HvARRAY(hv))
447         return;
448
449     riter = 0;
450     max = HvMAX(hv);
451     array = HvARRAY(hv);
452     hent = array[0];
453     for (;;) {
454         if (hent) {
455             ohent = hent;
456             hent = hent->hent_next;
457             he_free(ohent);
458         }
459         if (!hent) {
460             if (++riter > max)
461                 break;
462             hent = array[riter];
463         } 
464     }
465     (void)hv_iterinit(hv);
466 }
467
468 void
469 hv_undef(hv)
470 HV *hv;
471 {
472     register XPVHV* xhv;
473     if (!hv)
474         return;
475     xhv = (XPVHV*)SvANY(hv);
476     hfreeentries(hv);
477     Safefree(xhv->xhv_array);
478     if (HvNAME(hv)) {
479         Safefree(HvNAME(hv));
480         HvNAME(hv) = 0;
481     }
482     xhv->xhv_array = 0;
483     xhv->xhv_max = 7;           /* it's a normal associative array */
484     xhv->xhv_fill = 0;
485     xhv->xhv_keys = 0;
486
487     if (SvRMAGICAL(hv))
488         mg_clear((SV*)hv); 
489 }
490
491 I32
492 hv_iterinit(hv)
493 HV *hv;
494 {
495     register XPVHV* xhv = (XPVHV*)SvANY(hv);
496     HE *entry = xhv->xhv_eiter;
497     if (entry && entry->hent_klen < 0)  /* was deleted earlier? */
498         he_free(entry);
499     xhv->xhv_riter = -1;
500     xhv->xhv_eiter = Null(HE*);
501     return xhv->xhv_fill;
502 }
503
504 HE *
505 hv_iternext(hv)
506 HV *hv;
507 {
508     register XPVHV* xhv;
509     register HE *entry;
510     HE *oldentry;
511     MAGIC* mg;
512
513     if (!hv)
514         croak("Bad associative array");
515     xhv = (XPVHV*)SvANY(hv);
516     oldentry = entry = xhv->xhv_eiter;
517
518     if (SvRMAGICAL(hv) && (mg = mg_find((SV*)hv,'P'))) {
519         SV *key = sv_newmortal();
520         if (entry) {
521             sv_usepvn(key, entry->hent_key, entry->hent_klen);
522             entry->hent_key = 0;
523         }
524         else {
525             xhv->xhv_eiter = entry = new_he();
526             Zero(entry, 1, HE);
527         }
528         magic_nextpack((SV*) hv,mg,key);
529         if (SvOK(key)) {
530             STRLEN len;
531             entry->hent_key = SvPV_force(key, len);
532             entry->hent_klen = len;
533             SvPOK_off(key);
534             SvPVX(key) = 0;
535             return entry;
536         }
537         if (entry->hent_val)
538             SvREFCNT_dec(entry->hent_val);
539         del_he(entry);
540         xhv->xhv_eiter = Null(HE*);
541         return Null(HE*);
542     }
543
544     if (!xhv->xhv_array)
545         Newz(506,xhv->xhv_array, sizeof(HE*) * (xhv->xhv_max + 1), char);
546     do {
547         if (entry)
548             entry = entry->hent_next;
549         if (!entry) {
550             ++xhv->xhv_riter;
551             if (xhv->xhv_riter > xhv->xhv_max) {
552                 xhv->xhv_riter = -1;
553                 break;
554             }
555             entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
556         }
557     } while (!entry);
558
559     if (oldentry && oldentry->hent_klen < 0)    /* was deleted earlier? */
560         he_free(oldentry);
561
562     xhv->xhv_eiter = entry;
563     return entry;
564 }
565
566 char *
567 hv_iterkey(entry,retlen)
568 register HE *entry;
569 I32 *retlen;
570 {
571     *retlen = entry->hent_klen;
572     return entry->hent_key;
573 }
574
575 SV *
576 hv_iterval(hv,entry)
577 HV *hv;
578 register HE *entry;
579 {
580     if (SvRMAGICAL(hv)) {
581         if (mg_find((SV*)hv,'P')) {
582             SV* sv = sv_newmortal();
583             mg_copy((SV*)hv, sv, entry->hent_key, entry->hent_klen);
584             return sv;
585         }
586     }
587     return entry->hent_val;
588 }
589
590 SV *
591 hv_iternextsv(hv, key, retlen)
592     HV *hv;
593     char **key;
594     I32 *retlen;
595 {
596     HE *he;
597     if ( (he = hv_iternext(hv)) == NULL)
598         return NULL;
599     *key = hv_iterkey(he, retlen);
600     return hv_iterval(hv, he);
601 }
602
603 void
604 hv_magic(hv, gv, how)
605 HV* hv;
606 GV* gv;
607 int how;
608 {
609     sv_magic((SV*)hv, (SV*)gv, how, Nullch, 0);
610 }