Annotation of gforth/hash.fs, revision 1.2
1.1 pazsan 1: \ Hashed dictionaries 15jul94py
2:
1.2 ! anton 3: 7 value hashbits
! 4: 1 hashbits lshift Value Hashlen
1.1 pazsan 5:
6: Variable insRule insRule on
7:
8: \ Memory handling 15jul94py
9:
10: Variable HashPointer
11:
12: : hash-alloc ( addr -- addr ) dup @ 0= IF
13: Hashlen cells allocate throw over !
14: dup @ Hashlen cells erase THEN ;
15:
16: \ DelFix and NewFix is from bigFORTH 15jul94py
17:
18: : DelFix ( addr root -- ) dup @ 2 pick ! ! ;
19: : NewFix ( root len # -- addr )
20: BEGIN 2 pick @ ?dup 0= WHILE 2dup * allocate throw
21: over 0 ?DO dup 4 pick DelFix 2 pick + LOOP drop
22: REPEAT >r drop r@ @ rot ! r@ swap erase r> ;
23:
24: \ compute hash key 15jul94py
25:
1.2 ! anton 26: : hash ( addr len -- key )
! 27: hashbits (hashkey1) ;
! 28: \ (hashkey)
! 29: \ Hashlen 1- and ;
1.1 pazsan 30:
1.2 ! anton 31:
! 32: : hash-find ( addr len wordlist -- nfa / false )
! 33: $C + @ >r
! 34: 2dup hash cells r> + @ (hashfind) ;
1.1 pazsan 35: \ BEGIN dup WHILE
36: \ 2@ >r >r dup r@ cell+ c@ $1F and =
37: \ IF 2dup r@ cell+ char+ capscomp 0=
38: \ IF 2drop r> rdrop EXIT THEN THEN
39: \ rdrop r>
40: \ REPEAT nip nip ;
41:
42: \ hash vocabularies 16jul94py
43:
44: : lastlink! ( addr link -- )
45: BEGIN dup @ dup WHILE nip REPEAT drop ! ;
46:
47: : (reveal ( addr voc -- ) $C + dup @ 0< IF 2drop EXIT THEN
48: hash-alloc @ over cell+ count $1F and Hash cells + >r
49: HashPointer 8 $400 NewFix
50: tuck cell+ ! r> insRule @
51: IF dup @ 2 pick ! ! ELSE lastlink! THEN ;
52:
53: : hash-reveal ( -- ) (reveal) last? IF
54: current @ (reveal THEN ;
55:
56: Create hashsearch ' hash-find A, ' hash-reveal A, ' drop A,
57:
1.2 ! anton 58: : (initvoc ( addr -- )
! 59: cell+ dup @ 0< IF drop EXIT THEN
! 60: insRule @ >r insRule off hash-alloc
! 61: 3 cells - hashsearch over cell+ ! dup
! 62: BEGIN @ dup WHILE 2dup swap (reveal REPEAT
! 63: 2drop r> insRule ! ;
1.1 pazsan 64:
65: ' (initvoc IS 'initvoc
66:
1.2 ! anton 67: : addall ( -- )
! 68: voclink
! 69: BEGIN @ dup @ WHILE dup (initvoc REPEAT drop ;
1.1 pazsan 70:
71: \ Hash-Find 01jan93py
72:
73: addall \ Baum aufbauen
74: \ Baumsuche ist installiert.
75:
76: : .words ( -- )
77: base @ >r hex context @ 3 cells + HashLen 0
78: DO cr i 2 .r ." : " dup @ i cells +
79: BEGIN @ dup WHILE
80: dup cell+ @ .name REPEAT drop
81: LOOP drop r> base ! ;
82:
1.2 ! anton 83: \ \ this stuff is for evaluating the hash function
! 84: \ : square dup * ;
! 85:
! 86: \ : countwl ( -- sum sumsq )
! 87: \ \ gives the number of words in the current wordlist and the sum of
! 88: \ \ squares for the sublist lengths
! 89: \ 0 0
! 90: \ context @ 3 cells + @ hashlen cells over + swap DO
! 91: \ 0 i BEGIN
! 92: \ @ dup WHILE
! 93: \ swap 1+ swap
! 94: \ REPEAT
! 95: \ drop
! 96: \ swap over square +
! 97: \ >r + r>
! 98: \ 1 cells
! 99: \ +LOOP ;
! 100:
! 101: \ : chisq ( -- n )
! 102: \ \ n should have about the same size as hashlen
! 103: \ countwl hashlen 2 pick */ swap - ;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>