--- gforth/hash.fs	1994/07/21 10:52:43	1.1
+++ gforth/hash.fs	1994/08/25 15:25:27	1.2
@@ -1,6 +1,7 @@
 \ Hashed dictionaries                                  15jul94py
 
-$80 Value Hashlen
+7 value hashbits
+1 hashbits lshift Value Hashlen
 
 Variable insRule        insRule on
 
@@ -22,12 +23,15 @@ Variable HashPointer
 
 \ compute hash key                                     15jul94py
 
-: hash ( addr len -- key )  (hashkey)
-\  tuck bounds  ?DO  I c@ toupper +  LOOP
-  Hashlen 1- and ;
+: hash ( addr len -- key )
+    hashbits (hashkey1) ;
+\   (hashkey)
+\   Hashlen 1- and ;
 
-: hash-find ( addr len wordlist -- nfa / false ) $C + @ >r
-  2dup hash cells r> + @ (hashfind) ;
+
+: hash-find ( addr len wordlist -- nfa / false )
+    $C + @ >r
+    2dup hash cells r> + @ (hashfind) ;
 \  BEGIN  dup  WHILE
 \         2@ >r >r dup r@ cell+ c@ $1F and =
 \         IF  2dup r@ cell+ char+ capscomp 0=
@@ -51,16 +55,18 @@ Variable HashPointer
 
 Create hashsearch  ' hash-find A,  ' hash-reveal A,  ' drop A,
 
-: (initvoc ( addr -- )  cell+ dup @ 0< IF  drop EXIT  THEN
-  insRule @ >r  insRule off  hash-alloc
-  3 cells - hashsearch over cell+ ! dup
-  BEGIN  @ dup  WHILE  2dup swap (reveal  REPEAT
-  2drop  r> insRule ! ;
+: (initvoc ( addr -- )
+    cell+ dup @ 0< IF  drop EXIT  THEN
+    insRule @ >r  insRule off  hash-alloc
+    3 cells - hashsearch over cell+ ! dup
+    BEGIN  @ dup  WHILE  2dup swap (reveal  REPEAT
+    2drop  r> insRule ! ;
 
 ' (initvoc IS 'initvoc
 
-: addall  ( -- )  voclink
-  BEGIN  @ dup @  WHILE  dup (initvoc  REPEAT  drop ;
+: addall  ( -- )
+    voclink
+    BEGIN  @ dup @  WHILE  dup (initvoc  REPEAT  drop ;
 
 \ Hash-Find                                            01jan93py
 
@@ -74,3 +80,24 @@ addall          \ Baum aufbauen
              dup cell+ @ .name  REPEAT  drop
   LOOP  drop r> base ! ;
 
+\ \ this stuff is for evaluating the hash function
+\ : square dup * ;
+
+\ : countwl  ( -- sum sumsq )
+\     \ gives the number of words in the current wordlist and the sum of
+\     \ squares for the sublist lengths
+\     0 0
+\     context @ 3 cells + @ hashlen cells over + swap DO
+\ 	0 i BEGIN
+\ 	    @ dup WHILE
+\ 	    swap 1+ swap
+\ 	REPEAT
+\ 	drop
+\ 	swap over square +
+\ 	>r + r>
+\ 	1 cells
+\     +LOOP ;
+
+\ : chisq ( -- n )
+\     \ n should have about the same size as hashlen
+\     countwl hashlen 2 pick */ swap - ;