This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
perl 3.0 patch #32 patch #29, continued
[perl5.git] / hash.c
1 /* $Header: hash.c,v 3.0.1.6 90/10/15 17:32:52 lwall Locked $
2  *
3  *    Copyright (c) 1989, Larry Wall
4  *
5  *    You may distribute under the terms of the GNU General Public License
6  *    as specified in the README file that comes with the perl 3.0 kit.
7  *
8  * $Log:        hash.c,v $
9  * Revision 3.0.1.6  90/10/15  17:32:52  lwall
10  * patch29: non-existent array values no longer cause core dumps
11  * patch29: %foo = () will now clear dbm files
12  * patch29: dbm files couldn't be opened read only
13  * patch29: the cache array for dbm files wasn't correctly created on fetches
14  * 
15  * Revision 3.0.1.5  90/08/13  22:18:27  lwall
16  * patch28: defined(@array) and defined(%array) didn't work right
17  * 
18  * Revision 3.0.1.4  90/08/09  03:50:22  lwall
19  * patch19: dbmopen(name, 'filename', undef) now refrains from creating
20  * 
21  * Revision 3.0.1.3  90/03/27  15:59:09  lwall
22  * patch16: @dbmvalues{'foo','bar'} could use the same cache entry for both values
23  * 
24  * Revision 3.0.1.2  89/12/21  20:03:39  lwall
25  * patch7: errno may now be a macro with an lvalue
26  * 
27  * Revision 3.0.1.1  89/11/11  04:34:18  lwall
28  * patch2: CX/UX needed to set the key each time in associative iterators
29  * 
30  * Revision 3.0  89/10/18  15:18:32  lwall
31  * 3.0 baseline
32  * 
33  */
34
35 #include "EXTERN.h"
36 #include "perl.h"
37
38 static char coeff[] = {
39                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
40                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
41                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
42                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
43                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
44                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
45                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1,
46                 61,59,53,47,43,41,37,31,29,23,17,13,11,7,3,1};
47
48 static void hfreeentries();
49
50 STR *
51 hfetch(tb,key,klen,lval)
52 register HASH *tb;
53 char *key;
54 unsigned int klen;
55 int lval;
56 {
57     register char *s;
58     register int i;
59     register int hash;
60     register HENT *entry;
61     register int maxi;
62     STR *str;
63 #ifdef SOME_DBM
64     datum dkey,dcontent;
65 #endif
66
67     if (!tb)
68         return &str_undef;
69     if (!tb->tbl_array) {
70         if (lval)
71             Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*);
72         else
73             return &str_undef;
74     }
75
76     /* The hash function we use on symbols has to be equal to the first
77      * character when taken modulo 128, so that str_reset() can be implemented
78      * efficiently.  We throw in the second character and the last character
79      * (times 128) so that long chains of identifiers starting with the
80      * same letter don't have to be strEQ'ed within hfetch(), since it
81      * compares hash values before trying strEQ().
82      */
83     if (!tb->tbl_coeffsize)
84         hash = *key + 128 * key[1] + 128 * key[klen-1]; /* assuming klen > 0 */
85     else {      /* use normal coefficients */
86         if (klen < tb->tbl_coeffsize)
87             maxi = klen;
88         else
89             maxi = tb->tbl_coeffsize;
90         for (s=key,             i=0,    hash = 0;
91                             i < maxi;
92              s++,               i++,    hash *= 5) {
93             hash += *s * coeff[i];
94         }
95     }
96
97     entry = tb->tbl_array[hash & tb->tbl_max];
98     for (; entry; entry = entry->hent_next) {
99         if (entry->hent_hash != hash)           /* strings can't be equal */
100             continue;
101         if (entry->hent_klen != klen)
102             continue;
103         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
104             continue;
105         return entry->hent_val;
106     }
107 #ifdef SOME_DBM
108     if (tb->tbl_dbm) {
109         dkey.dptr = key;
110         dkey.dsize = klen;
111         dcontent = dbm_fetch(tb->tbl_dbm,dkey);
112         if (dcontent.dptr) {                    /* found one */
113             str = Str_new(60,dcontent.dsize);
114             str_nset(str,dcontent.dptr,dcontent.dsize);
115             hstore(tb,key,klen,str,hash);               /* cache it */
116             return str;
117         }
118     }
119 #endif
120     if (lval) {         /* gonna assign to this, so it better be there */
121         str = Str_new(61,0);
122         hstore(tb,key,klen,str,hash);
123         return str;
124     }
125     return &str_undef;
126 }
127
128 bool
129 hstore(tb,key,klen,val,hash)
130 register HASH *tb;
131 char *key;
132 unsigned int klen;
133 STR *val;
134 register int hash;
135 {
136     register char *s;
137     register int i;
138     register HENT *entry;
139     register HENT **oentry;
140     register int maxi;
141
142     if (!tb)
143         return FALSE;
144
145     if (hash)
146         ;
147     else if (!tb->tbl_coeffsize)
148         hash = *key + 128 * key[1] + 128 * key[klen-1];
149     else {      /* use normal coefficients */
150         if (klen < tb->tbl_coeffsize)
151             maxi = klen;
152         else
153             maxi = tb->tbl_coeffsize;
154         for (s=key,             i=0,    hash = 0;
155                             i < maxi;
156              s++,               i++,    hash *= 5) {
157             hash += *s * coeff[i];
158         }
159     }
160
161     if (!tb->tbl_array)
162         Newz(505,tb->tbl_array, tb->tbl_max + 1, HENT*);
163
164     oentry = &(tb->tbl_array[hash & tb->tbl_max]);
165     i = 1;
166
167     for (entry = *oentry; entry; i=0, entry = entry->hent_next) {
168         if (entry->hent_hash != hash)           /* strings can't be equal */
169             continue;
170         if (entry->hent_klen != klen)
171             continue;
172         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
173             continue;
174         Safefree(entry->hent_val);
175         entry->hent_val = val;
176         return TRUE;
177     }
178     New(501,entry, 1, HENT);
179
180     entry->hent_klen = klen;
181     entry->hent_key = nsavestr(key,klen);
182     entry->hent_val = val;
183     entry->hent_hash = hash;
184     entry->hent_next = *oentry;
185     *oentry = entry;
186
187     /* hdbmstore not necessary here because it's called from stabset() */
188
189     if (i) {                            /* initial entry? */
190         tb->tbl_fill++;
191 #ifdef SOME_DBM
192         if (tb->tbl_dbm && tb->tbl_max >= DBM_CACHE_MAX)
193             return FALSE;
194 #endif
195         if (tb->tbl_fill > tb->tbl_dosplit)
196             hsplit(tb);
197     }
198 #ifdef SOME_DBM
199     else if (tb->tbl_dbm) {             /* is this just a cache for dbm file? */
200         void hentdelayfree();
201
202         entry = tb->tbl_array[hash & tb->tbl_max];
203         oentry = &entry->hent_next;
204         entry = *oentry;
205         while (entry) { /* trim chain down to 1 entry */
206             *oentry = entry->hent_next;
207             hentdelayfree(entry);       /* no doubt they'll want this next. */
208             entry = *oentry;
209         }
210     }
211 #endif
212
213     return FALSE;
214 }
215
216 STR *
217 hdelete(tb,key,klen)
218 register HASH *tb;
219 char *key;
220 unsigned int klen;
221 {
222     register char *s;
223     register int i;
224     register int hash;
225     register HENT *entry;
226     register HENT **oentry;
227     STR *str;
228     int maxi;
229 #ifdef SOME_DBM
230     datum dkey;
231 #endif
232
233     if (!tb || !tb->tbl_array)
234         return Nullstr;
235     if (!tb->tbl_coeffsize)
236         hash = *key + 128 * key[1] + 128 * key[klen-1];
237     else {      /* use normal coefficients */
238         if (klen < tb->tbl_coeffsize)
239             maxi = klen;
240         else
241             maxi = tb->tbl_coeffsize;
242         for (s=key,             i=0,    hash = 0;
243                             i < maxi;
244              s++,               i++,    hash *= 5) {
245             hash += *s * coeff[i];
246         }
247     }
248
249     oentry = &(tb->tbl_array[hash & tb->tbl_max]);
250     entry = *oentry;
251     i = 1;
252     for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
253         if (entry->hent_hash != hash)           /* strings can't be equal */
254             continue;
255         if (entry->hent_klen != klen)
256             continue;
257         if (bcmp(entry->hent_key,key,klen))     /* is this it? */
258             continue;
259         *oentry = entry->hent_next;
260         str = str_static(entry->hent_val);
261         hentfree(entry);
262         if (i)
263             tb->tbl_fill--;
264 #ifdef SOME_DBM
265       do_dbm_delete:
266         if (tb->tbl_dbm) {
267             dkey.dptr = key;
268             dkey.dsize = klen;
269             dbm_delete(tb->tbl_dbm,dkey);
270         }
271 #endif
272         return str;
273     }
274 #ifdef SOME_DBM
275     str = Nullstr;
276     goto do_dbm_delete;
277 #else
278     return Nullstr;
279 #endif
280 }
281
282 hsplit(tb)
283 HASH *tb;
284 {
285     int oldsize = tb->tbl_max + 1;
286     register int newsize = oldsize * 2;
287     register int i;
288     register HENT **a;
289     register HENT **b;
290     register HENT *entry;
291     register HENT **oentry;
292
293     a = tb->tbl_array;
294     Renew(a, newsize, HENT*);
295     Zero(&a[oldsize], oldsize, HENT*);          /* zero 2nd half*/
296     tb->tbl_max = --newsize;
297     tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100;
298     tb->tbl_array = a;
299
300     for (i=0; i<oldsize; i++,a++) {
301         if (!*a)                                /* non-existent */
302             continue;
303         b = a+oldsize;
304         for (oentry = a, entry = *a; entry; entry = *oentry) {
305             if ((entry->hent_hash & newsize) != i) {
306                 *oentry = entry->hent_next;
307                 entry->hent_next = *b;
308                 if (!*b)
309                     tb->tbl_fill++;
310                 *b = entry;
311                 continue;
312             }
313             else
314                 oentry = &entry->hent_next;
315         }
316         if (!*a)                                /* everything moved */
317             tb->tbl_fill--;
318     }
319 }
320
321 HASH *
322 hnew(lookat)
323 unsigned int lookat;
324 {
325     register HASH *tb;
326
327     Newz(502,tb, 1, HASH);
328     if (lookat) {
329         tb->tbl_coeffsize = lookat;
330         tb->tbl_max = 7;                /* it's a normal associative array */
331         tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100;
332     }
333     else {
334         tb->tbl_max = 127;              /* it's a symbol table */
335         tb->tbl_dosplit = 128;          /* so never split */
336     }
337     tb->tbl_fill = 0;
338 #ifdef SOME_DBM
339     tb->tbl_dbm = 0;
340 #endif
341     (void)hiterinit(tb);        /* so each() will start off right */
342     return tb;
343 }
344
345 void
346 hentfree(hent)
347 register HENT *hent;
348 {
349     if (!hent)
350         return;
351     str_free(hent->hent_val);
352     Safefree(hent->hent_key);
353     Safefree(hent);
354 }
355
356 void
357 hentdelayfree(hent)
358 register HENT *hent;
359 {
360     if (!hent)
361         return;
362     str_2static(hent->hent_val);        /* free between statements */
363     Safefree(hent->hent_key);
364     Safefree(hent);
365 }
366
367 void
368 hclear(tb,dodbm)
369 register HASH *tb;
370 int dodbm;
371 {
372     if (!tb)
373         return;
374     hfreeentries(tb,dodbm);
375     tb->tbl_fill = 0;
376 #ifndef lint
377     if (tb->tbl_array)
378         (void)bzero((char*)tb->tbl_array, (tb->tbl_max + 1) * sizeof(HENT*));
379 #endif
380 }
381
382 static void
383 hfreeentries(tb,dodbm)
384 register HASH *tb;
385 int dodbm;
386 {
387     register HENT *hent;
388     register HENT *ohent = Null(HENT*);
389 #ifdef SOME_DBM
390     datum dkey;
391     datum nextdkey;
392 #ifdef NDBM
393     DBM *old_dbm;
394 #else
395     int old_dbm;
396 #endif
397 #endif
398
399     if (!tb || !tb->tbl_array)
400         return;
401 #ifdef SOME_DBM
402     if ((old_dbm = tb->tbl_dbm) && dodbm) {
403         while (dkey = dbm_firstkey(tb->tbl_dbm), dkey.dptr) {
404             do {
405                 nextdkey = dbm_nextkey(tb->tbl_dbm, dkey);
406                 dbm_delete(tb->tbl_dbm,dkey);
407                 dkey = nextdkey;
408             } while (dkey.dptr);        /* one way or another, this works */
409         }
410     }
411     tb->tbl_dbm = 0;                    /* now clear just cache */
412 #endif
413     (void)hiterinit(tb);
414     while (hent = hiternext(tb)) {      /* concise but not very efficient */
415         hentfree(ohent);
416         ohent = hent;
417     }
418     hentfree(ohent);
419 #ifdef SOME_DBM
420     tb->tbl_dbm = old_dbm;
421 #endif
422 }
423
424 void
425 hfree(tb,dodbm)
426 register HASH *tb;
427 int dodbm;
428 {
429     if (!tb)
430         return;
431     hfreeentries(tb,dodbm);
432     Safefree(tb->tbl_array);
433     Safefree(tb);
434 }
435
436 int
437 hiterinit(tb)
438 register HASH *tb;
439 {
440     tb->tbl_riter = -1;
441     tb->tbl_eiter = Null(HENT*);
442     return tb->tbl_fill;
443 }
444
445 HENT *
446 hiternext(tb)
447 register HASH *tb;
448 {
449     register HENT *entry;
450 #ifdef SOME_DBM
451     datum key;
452 #endif
453
454     entry = tb->tbl_eiter;
455 #ifdef SOME_DBM
456     if (tb->tbl_dbm) {
457         if (entry) {
458 #ifdef NDBM
459 #ifdef _CX_UX
460             key.dptr = entry->hent_key;
461             key.dsize = entry->hent_klen;
462             key = dbm_nextkey(tb->tbl_dbm, key);
463 #else
464             key = dbm_nextkey(tb->tbl_dbm);
465 #endif /* _CX_UX */
466 #else
467             key.dptr = entry->hent_key;
468             key.dsize = entry->hent_klen;
469             key = nextkey(key);
470 #endif
471         }
472         else {
473             Newz(504,entry, 1, HENT);
474             tb->tbl_eiter = entry;
475             key = dbm_firstkey(tb->tbl_dbm);
476         }
477         entry->hent_key = key.dptr;
478         entry->hent_klen = key.dsize;
479         if (!key.dptr) {
480             if (entry->hent_val)
481                 str_free(entry->hent_val);
482             Safefree(entry);
483             tb->tbl_eiter = Null(HENT*);
484             return Null(HENT*);
485         }
486         return entry;
487     }
488 #endif
489     if (!tb->tbl_array)
490         Newz(506,tb->tbl_array, tb->tbl_max + 1, HENT*);
491     do {
492         if (entry)
493             entry = entry->hent_next;
494         if (!entry) {
495             tb->tbl_riter++;
496             if (tb->tbl_riter > tb->tbl_max) {
497                 tb->tbl_riter = -1;
498                 break;
499             }
500             entry = tb->tbl_array[tb->tbl_riter];
501         }
502     } while (!entry);
503
504     tb->tbl_eiter = entry;
505     return entry;
506 }
507
508 char *
509 hiterkey(entry,retlen)
510 register HENT *entry;
511 int *retlen;
512 {
513     *retlen = entry->hent_klen;
514     return entry->hent_key;
515 }
516
517 STR *
518 hiterval(tb,entry)
519 register HASH *tb;
520 register HENT *entry;
521 {
522 #ifdef SOME_DBM
523     datum key, content;
524
525     if (tb->tbl_dbm) {
526         key.dptr = entry->hent_key;
527         key.dsize = entry->hent_klen;
528         content = dbm_fetch(tb->tbl_dbm,key);
529         if (!entry->hent_val)
530             entry->hent_val = Str_new(62,0);
531         str_nset(entry->hent_val,content.dptr,content.dsize);
532     }
533 #endif
534     return entry->hent_val;
535 }
536
537 #ifdef SOME_DBM
538 #if     defined(FCNTL) && ! defined(O_CREAT)
539 #include <fcntl.h>
540 #endif
541
542 #ifndef O_RDONLY
543 #define O_RDONLY 0
544 #endif
545 #ifndef O_RDWR
546 #define O_RDWR 2
547 #endif
548 #ifndef O_CREAT
549 #define O_CREAT 01000
550 #endif
551
552 #ifndef NDBM
553 static int dbmrefcnt = 0;
554 #endif
555
556 bool
557 hdbmopen(tb,fname,mode)
558 register HASH *tb;
559 char *fname;
560 int mode;
561 {
562     if (!tb)
563         return FALSE;
564 #ifndef NDBM
565     if (tb->tbl_dbm)    /* never really closed it */
566         return TRUE;
567 #endif
568     if (tb->tbl_dbm) {
569         hdbmclose(tb);
570         tb->tbl_dbm = 0;
571     }
572     hclear(tb, FALSE);  /* clear cache */
573 #ifdef NDBM
574     if (mode >= 0)
575         tb->tbl_dbm = dbm_open(fname, O_RDWR|O_CREAT, mode);
576     if (!tb->tbl_dbm)
577         tb->tbl_dbm = dbm_open(fname, O_RDWR, mode);
578     if (!tb->tbl_dbm)
579         tb->tbl_dbm = dbm_open(fname, O_RDONLY, mode);
580 #else
581     if (dbmrefcnt++)
582         fatal("Old dbm can only open one database");
583     sprintf(buf,"%s.dir",fname);
584     if (stat(buf, &statbuf) < 0) {
585         if (mode < 0 || close(creat(buf,mode)) < 0)
586             return FALSE;
587         sprintf(buf,"%s.pag",fname);
588         if (close(creat(buf,mode)) < 0)
589             return FALSE;
590     }
591     tb->tbl_dbm = dbminit(fname) >= 0;
592 #endif
593     if (!tb->tbl_array && tb->tbl_dbm != 0)
594         Newz(507,tb->tbl_array, tb->tbl_max + 1, HENT*);
595     return tb->tbl_dbm != 0;
596 }
597
598 void
599 hdbmclose(tb)
600 register HASH *tb;
601 {
602     if (tb && tb->tbl_dbm) {
603 #ifdef NDBM
604         dbm_close(tb->tbl_dbm);
605         tb->tbl_dbm = 0;
606 #else
607         /* dbmrefcnt--;  */     /* doesn't work, rats */
608 #endif
609     }
610     else if (dowarn)
611         warn("Close on unopened dbm file");
612 }
613
614 bool
615 hdbmstore(tb,key,klen,str)
616 register HASH *tb;
617 char *key;
618 unsigned int klen;
619 register STR *str;
620 {
621     datum dkey, dcontent;
622     int error;
623
624     if (!tb || !tb->tbl_dbm)
625         return FALSE;
626     dkey.dptr = key;
627     dkey.dsize = klen;
628     dcontent.dptr = str_get(str);
629     dcontent.dsize = str->str_cur;
630     error = dbm_store(tb->tbl_dbm, dkey, dcontent, DBM_REPLACE);
631     if (error) {
632         if (errno == EPERM)
633             fatal("No write permission to dbm file");
634         warn("dbm store returned %d, errno %d, key \"%s\"",error,errno,key);
635 #ifdef NDBM
636         dbm_clearerr(tb->tbl_dbm);
637 #endif
638     }
639     return !error;
640 }
641 #endif /* SOME_DBM */