File:
[gforth] /
gforth /
hash.fs
Revision
1.18:
download - view:
text,
annotated -
select for diffs
Sun Jul 6 15:55:24 1997 UTC (26 years, 8 months ago) by
jwilke
Branches:
MAIN
CVS tags:
HEAD
Major change!
hash and search does not rely on each other.
context and voclink are now present in kernel.
words and marker can now defined without loading hash or search
marker went to extend.fs
word went to kernel/tools.fs
table goes to seperate file (at the moment)
glocals.fs and kernel/toolsext.fs are changed because of the change in the
wordlist-map-struct...
Attention: You can't recompile the code without new kernel-files!!!
jens
1: \ Hashed dictionaries 15jul94py
2:
3: \ Copyright (C) 1995 Free Software Foundation, Inc.
4:
5: \ This file is part of Gforth.
6:
7: \ Gforth is free software; you can redistribute it and/or
8: \ modify it under the terms of the GNU General Public License
9: \ as published by the Free Software Foundation; either version 2
10: \ of the License, or (at your option) any later version.
11:
12: \ This program is distributed in the hope that it will be useful,
13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15: \ GNU General Public License for more details.
16:
17: \ You should have received a copy of the GNU General Public License
18: \ along with this program; if not, write to the Free Software
19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20:
21: [IFUNDEF] e? : e? name 2drop false ; [THEN]
22:
23: e? ec
24: [IF]
25: : reserve-mem here swap allot ;
26: \ ToDo: check memory space with unused
27: \ move to a kernel/memory.fs
28: [ELSE]
29: : reserve-mem allocate throw ;
30: [THEN]
31:
32: [IFUNDEF] hashbits
33: 11 value hashbits
34: [THEN]
35: 1 hashbits lshift Value Hashlen
36:
37: \ compute hash key 15jul94py
38:
39: [IFUNDEF] hash
40: : hash ( addr len -- key )
41: hashbits (hashkey1) ;
42: [THEN]
43:
44: Variable insRule insRule on
45: Variable revealed
46:
47: \ Memory handling 10oct94py
48:
49: Variable HashPointer
50: Variable HashIndex
51: 0 Value HashTable
52:
53: \ forward declarations
54: 0 Value hashsearch-map
55: Defer hash-alloc
56:
57: \ DelFix and NewFix are from bigFORTH 15jul94py
58:
59: : DelFix ( addr root -- ) dup @ 2 pick ! ! ;
60: : NewFix ( root len # -- addr )
61: BEGIN 2 pick @ ?dup 0= WHILE 2dup * reserve-mem
62: over 0 ?DO dup 4 pick DelFix 2 pick + LOOP drop
63: REPEAT >r drop r@ @ rot ! r@ swap erase r> ;
64:
65: : bucket ( addr len wordlist -- bucket-addr )
66: \ @var{bucket-addr} is the address of a cell that points to the first
67: \ element in the list of the bucket for the string @var{addr len}
68: wordlist-extend @ -rot hash xor ( bucket# )
69: cells HashTable + ;
70:
71: : hash-find ( addr len wordlist -- nfa / false )
72: >r 2dup r> bucket @ (hashfind) ;
73:
74: \ hash vocabularies 16jul94py
75:
76: : lastlink! ( addr link -- )
77: BEGIN dup @ dup WHILE nip REPEAT drop ! ;
78:
79: : (reveal ( nfa wid -- )
80: over name>string rot bucket >r
81: HashPointer 2 Cells $400 NewFix
82: tuck cell+ ! r> insRule @
83: IF
84: dup @ 2 pick ! !
85: ELSE
86: lastlink!
87: THEN
88: revealed on ;
89:
90: : hash-reveal ( nfa wid -- )
91: 2dup (reveal) (reveal ;
92:
93: : inithash ( wid -- )
94: wordlist-extend
95: insRule @ >r insRule off hash-alloc 3 cells - dup
96: BEGIN @ dup WHILE 2dup swap (reveal REPEAT
97: 2drop r> insRule ! ;
98:
99: : addall ( -- )
100: voclink
101: BEGIN @ dup WHILE
102: dup 0 wordlist-link -
103: dup wordlist-map @ hashsearch-map =
104: IF inithash ELSE drop THEN
105: REPEAT drop ;
106:
107: : clearhash ( -- )
108: HashTable Hashlen cells bounds
109: DO I @
110: BEGIN dup WHILE
111: dup @ swap HashPointer DelFix
112: REPEAT I !
113: cell +LOOP HashIndex off
114: voclink
115: BEGIN @ dup WHILE
116: dup 0 wordlist-link -
117: dup wordlist-map @ hashsearch-map =
118: IF 0 swap wordlist-extend ! ELSE drop THEN
119: REPEAT drop ;
120:
121: : rehashall ( wid -- )
122: drop revealed @
123: IF clearhash addall revealed off
124: THEN ;
125:
126: : (rehash) ( wid -- )
127: dup wordlist-extend @ 0=
128: IF inithash
129: ELSE rehashall THEN ;
130:
131: \ >rom ?!
132: align here ' hash-find A, ' hash-reveal A, ' (rehash) A, ' (rehash) A,
133: to hashsearch-map
134:
135: \ hash allocate and vocabulary initialization 10oct94py
136:
137: :noname ( hash-alloc ) ( addr -- addr )
138: HashTable 0=
139: IF Hashlen cells reserve-mem TO HashTable
140: HashTable Hashlen cells erase THEN
141: HashIndex @ over ! 1 HashIndex +!
142: HashIndex @ Hashlen >=
143: [ e? ec [IF] ]
144: ABORT" no more space in hashtable"
145: [ [ELSE] ]
146: IF HashTable >r clearhash
147: 1 hashbits 1+ dup to hashbits lshift to hashlen
148: r> free >r 0 to HashTable
149: addall r> throw
150: THEN
151: [ [THEN] ] ; is hash-alloc
152:
153: \ Hash-Find 01jan93py
154: e? cross 0=
155: [IF]
156: : make-hash
157: hashsearch-map forth-wordlist cell+ !
158: addall ;
159: make-hash \ Baumsuche ist installiert.
160: [ELSE]
161: hashsearch-map forth-wordlist cell+ !
162: [THEN]
163:
164: \ for ec version display that vocabulary goes hashed
165:
166: : hash-cold ( -- )
167: [ e? ec [IF] ] ." Hashing..." [ [THEN] ]
168: HashPointer off 0 TO HashTable HashIndex off
169: addall
170: \ voclink
171: \ BEGIN @ dup WHILE
172: \ dup 0 wordlist-link - initvoc
173: \ REPEAT drop
174: [ e? ec [IF] ] ." Done" cr [ [THEN] ] ;
175:
176: ' hash-cold INIT8 chained
177:
178: : .words ( -- )
179: base @ >r hex HashTable Hashlen 0
180: DO cr i 2 .r ." : " dup i cells +
181: BEGIN @ dup WHILE
182: dup cell+ @ head>string type space REPEAT drop
183: LOOP drop r> base ! ;
184:
185: \ \ this stuff is for evaluating the hash function
186: \ : square dup * ;
187:
188: \ : countwl ( -- sum sumsq )
189: \ \ gives the number of words in the current wordlist
190: \ \ and the sum of squares for the sublist lengths
191: \ 0 0
192: \ hashtable Hashlen cells bounds DO
193: \ 0 i BEGIN
194: \ @ dup WHILE
195: \ swap 1+ swap
196: \ REPEAT
197: \ drop
198: \ swap over square +
199: \ >r + r>
200: \ 1 cells
201: \ +LOOP ;
202:
203: \ : chisq ( -- n )
204: \ \ n should have about the same size as Hashlen
205: \ countwl Hashlen 2 pick */ swap - ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>