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