perl 3.0 patch #32 patch #29, continued
[p5sagit/p5-mst-13.2.git] / hash.c
CommitLineData
d9d8d8de 1/* $Header: hash.c,v 3.0.1.6 90/10/15 17:32:52 lwall Locked $
a687059c 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.
8d063cd8 7 *
8 * $Log: hash.c,v $
d9d8d8de 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 *
6eb13c3b 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 *
154e51a4 18 * Revision 3.0.1.4 90/08/09 03:50:22 lwall
19 * patch19: dbmopen(name, 'filename', undef) now refrains from creating
20 *
b1248f16 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 *
663a0e37 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 *
bf38876a 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 *
a687059c 30 * Revision 3.0 89/10/18 15:18:32 lwall
31 * 3.0 baseline
8d063cd8 32 *
33 */
34
8d063cd8 35#include "EXTERN.h"
8d063cd8 36#include "perl.h"
37
154e51a4 38static 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
d9d8d8de 48static void hfreeentries();
49
8d063cd8 50STR *
a687059c 51hfetch(tb,key,klen,lval)
8d063cd8 52register HASH *tb;
53char *key;
d9d8d8de 54unsigned int klen;
a687059c 55int lval;
8d063cd8 56{
57 register char *s;
58 register int i;
59 register int hash;
60 register HENT *entry;
a687059c 61 register int maxi;
62 STR *str;
63#ifdef SOME_DBM
64 datum dkey,dcontent;
65#endif
8d063cd8 66
67 if (!tb)
d9d8d8de 68 return &str_undef;
6eb13c3b 69 if (!tb->tbl_array) {
70 if (lval)
71 Newz(503,tb->tbl_array, tb->tbl_max + 1, HENT*);
72 else
d9d8d8de 73 return &str_undef;
6eb13c3b 74 }
a687059c 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 }
8d063cd8 95 }
a687059c 96
8d063cd8 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;
a687059c 101 if (entry->hent_klen != klen)
102 continue;
103 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
8d063cd8 104 continue;
105 return entry->hent_val;
106 }
a687059c 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 }
d9d8d8de 125 return &str_undef;
8d063cd8 126}
127
128bool
a687059c 129hstore(tb,key,klen,val,hash)
8d063cd8 130register HASH *tb;
131char *key;
d9d8d8de 132unsigned int klen;
8d063cd8 133STR *val;
a687059c 134register int hash;
8d063cd8 135{
136 register char *s;
137 register int i;
8d063cd8 138 register HENT *entry;
139 register HENT **oentry;
a687059c 140 register int maxi;
8d063cd8 141
142 if (!tb)
143 return FALSE;
a687059c 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 }
8d063cd8 159 }
160
6eb13c3b 161 if (!tb->tbl_array)
162 Newz(505,tb->tbl_array, tb->tbl_max + 1, HENT*);
163
8d063cd8 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;
a687059c 170 if (entry->hent_klen != klen)
171 continue;
172 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
8d063cd8 173 continue;
a687059c 174 Safefree(entry->hent_val);
8d063cd8 175 entry->hent_val = val;
176 return TRUE;
177 }
a687059c 178 New(501,entry, 1, HENT);
8d063cd8 179
a687059c 180 entry->hent_klen = klen;
181 entry->hent_key = nsavestr(key,klen);
8d063cd8 182 entry->hent_val = val;
183 entry->hent_hash = hash;
184 entry->hent_next = *oentry;
185 *oentry = entry;
186
a687059c 187 /* hdbmstore not necessary here because it's called from stabset() */
188
8d063cd8 189 if (i) { /* initial entry? */
190 tb->tbl_fill++;
a687059c 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)
8d063cd8 196 hsplit(tb);
197 }
a687059c 198#ifdef SOME_DBM
199 else if (tb->tbl_dbm) { /* is this just a cache for dbm file? */
b1248f16 200 void hentdelayfree();
201
a687059c 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;
b1248f16 207 hentdelayfree(entry); /* no doubt they'll want this next. */
a687059c 208 entry = *oentry;
209 }
210 }
211#endif
8d063cd8 212
213 return FALSE;
214}
215
378cc40b 216STR *
a687059c 217hdelete(tb,key,klen)
8d063cd8 218register HASH *tb;
219char *key;
d9d8d8de 220unsigned int klen;
8d063cd8 221{
222 register char *s;
223 register int i;
224 register int hash;
225 register HENT *entry;
226 register HENT **oentry;
378cc40b 227 STR *str;
a687059c 228 int maxi;
229#ifdef SOME_DBM
230 datum dkey;
231#endif
8d063cd8 232
6eb13c3b 233 if (!tb || !tb->tbl_array)
378cc40b 234 return Nullstr;
a687059c 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 }
8d063cd8 247 }
248
249 oentry = &(tb->tbl_array[hash & tb->tbl_max]);
250 entry = *oentry;
251 i = 1;
378cc40b 252 for (; entry; i=0, oentry = &entry->hent_next, entry = *oentry) {
8d063cd8 253 if (entry->hent_hash != hash) /* strings can't be equal */
254 continue;
a687059c 255 if (entry->hent_klen != klen)
256 continue;
257 if (bcmp(entry->hent_key,key,klen)) /* is this it? */
8d063cd8 258 continue;
8d063cd8 259 *oentry = entry->hent_next;
378cc40b 260 str = str_static(entry->hent_val);
261 hentfree(entry);
8d063cd8 262 if (i)
263 tb->tbl_fill--;
a687059c 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
378cc40b 272 return str;
8d063cd8 273 }
a687059c 274#ifdef SOME_DBM
275 str = Nullstr;
276 goto do_dbm_delete;
277#else
378cc40b 278 return Nullstr;
a687059c 279#endif
8d063cd8 280}
8d063cd8 281
282hsplit(tb)
283HASH *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
a687059c 293 a = tb->tbl_array;
294 Renew(a, newsize, HENT*);
295 Zero(&a[oldsize], oldsize, HENT*); /* zero 2nd half*/
8d063cd8 296 tb->tbl_max = --newsize;
a687059c 297 tb->tbl_dosplit = tb->tbl_max * FILLPCT / 100;
8d063cd8 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
321HASH *
a687059c 322hnew(lookat)
323unsigned int lookat;
8d063cd8 324{
a687059c 325 register HASH *tb;
8d063cd8 326
a687059c 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 }
8d063cd8 337 tb->tbl_fill = 0;
a687059c 338#ifdef SOME_DBM
339 tb->tbl_dbm = 0;
340#endif
341 (void)hiterinit(tb); /* so each() will start off right */
8d063cd8 342 return tb;
343}
344
378cc40b 345void
346hentfree(hent)
347register HENT *hent;
348{
349 if (!hent)
350 return;
351 str_free(hent->hent_val);
a687059c 352 Safefree(hent->hent_key);
353 Safefree(hent);
378cc40b 354}
355
356void
b1248f16 357hentdelayfree(hent)
358register 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
367void
d9d8d8de 368hclear(tb,dodbm)
369register HASH *tb;
370int 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
382static void
383hfreeentries(tb,dodbm)
378cc40b 384register HASH *tb;
d9d8d8de 385int dodbm;
378cc40b 386{
387 register HENT *hent;
388 register HENT *ohent = Null(HENT*);
d9d8d8de 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
378cc40b 398
6eb13c3b 399 if (!tb || !tb->tbl_array)
378cc40b 400 return;
d9d8d8de 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
a687059c 413 (void)hiterinit(tb);
378cc40b 414 while (hent = hiternext(tb)) { /* concise but not very efficient */
415 hentfree(ohent);
416 ohent = hent;
417 }
418 hentfree(ohent);
d9d8d8de 419#ifdef SOME_DBM
420 tb->tbl_dbm = old_dbm;
a687059c 421#endif
378cc40b 422}
423
378cc40b 424void
d9d8d8de 425hfree(tb,dodbm)
a687059c 426register HASH *tb;
d9d8d8de 427int dodbm;
378cc40b 428{
429 if (!tb)
a687059c 430 return;
d9d8d8de 431 hfreeentries(tb,dodbm);
a687059c 432 Safefree(tb->tbl_array);
433 Safefree(tb);
378cc40b 434}
8d063cd8 435
a687059c 436int
8d063cd8 437hiterinit(tb)
438register HASH *tb;
439{
440 tb->tbl_riter = -1;
441 tb->tbl_eiter = Null(HENT*);
442 return tb->tbl_fill;
443}
444
445HENT *
446hiternext(tb)
447register HASH *tb;
448{
449 register HENT *entry;
a687059c 450#ifdef SOME_DBM
451 datum key;
452#endif
8d063cd8 453
454 entry = tb->tbl_eiter;
a687059c 455#ifdef SOME_DBM
456 if (tb->tbl_dbm) {
457 if (entry) {
458#ifdef NDBM
459#ifdef _CX_UX
bf38876a 460 key.dptr = entry->hent_key;
461 key.dsize = entry->hent_klen;
a687059c 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
6eb13c3b 489 if (!tb->tbl_array)
490 Newz(506,tb->tbl_array, tb->tbl_max + 1, HENT*);
8d063cd8 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
508char *
a687059c 509hiterkey(entry,retlen)
8d063cd8 510register HENT *entry;
a687059c 511int *retlen;
8d063cd8 512{
a687059c 513 *retlen = entry->hent_klen;
8d063cd8 514 return entry->hent_key;
515}
516
517STR *
a687059c 518hiterval(tb,entry)
519register HASH *tb;
8d063cd8 520register HENT *entry;
521{
a687059c 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
8d063cd8 534 return entry->hent_val;
535}
a687059c 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
553static int dbmrefcnt = 0;
554#endif
555
556bool
557hdbmopen(tb,fname,mode)
558register HASH *tb;
559char *fname;
560int 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
154e51a4 568 if (tb->tbl_dbm) {
a687059c 569 hdbmclose(tb);
154e51a4 570 tb->tbl_dbm = 0;
571 }
d9d8d8de 572 hclear(tb, FALSE); /* clear cache */
a687059c 573#ifdef NDBM
154e51a4 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);
d9d8d8de 578 if (!tb->tbl_dbm)
579 tb->tbl_dbm = dbm_open(fname, O_RDONLY, mode);
a687059c 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) {
154e51a4 585 if (mode < 0 || close(creat(buf,mode)) < 0)
a687059c 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
d9d8d8de 593 if (!tb->tbl_array && tb->tbl_dbm != 0)
594 Newz(507,tb->tbl_array, tb->tbl_max + 1, HENT*);
a687059c 595 return tb->tbl_dbm != 0;
596}
597
598void
599hdbmclose(tb)
600register 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
614bool
615hdbmstore(tb,key,klen,str)
616register HASH *tb;
617char *key;
d9d8d8de 618unsigned int klen;
a687059c 619register 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 */