Diff for /gforth/hash.fs between versions 1.1 and 1.2

version 1.1, 1994/07/21 10:52:43 version 1.2, 1994/08/25 15:25:27
Line 1 Line 1
 \ Hashed dictionaries                                  15jul94py  \ Hashed dictionaries                                  15jul94py
   
 $80 Value Hashlen  7 value hashbits
   1 hashbits lshift Value Hashlen
   
 Variable insRule        insRule on  Variable insRule        insRule on
   
Line 22  Variable HashPointer Line 23  Variable HashPointer
   
 \ compute hash key                                     15jul94py  \ compute hash key                                     15jul94py
   
 : hash ( addr len -- key )  (hashkey)  : hash ( addr len -- key )
 \  tuck bounds  ?DO  I c@ toupper +  LOOP      hashbits (hashkey1) ;
   Hashlen 1- and ;  \   (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  \  BEGIN  dup  WHILE
 \         2@ >r >r dup r@ cell+ c@ $1F and =  \         2@ >r >r dup r@ cell+ c@ $1F and =
 \         IF  2dup r@ cell+ char+ capscomp 0=  \         IF  2dup r@ cell+ char+ capscomp 0=
Line 51  Variable HashPointer Line 55  Variable HashPointer
   
 Create hashsearch  ' hash-find A,  ' hash-reveal A,  ' drop A,  Create hashsearch  ' hash-find A,  ' hash-reveal A,  ' drop A,
   
 : (initvoc ( addr -- )  cell+ dup @ 0< IF  drop EXIT  THEN  : (initvoc ( addr -- )
   insRule @ >r  insRule off  hash-alloc      cell+ dup @ 0< IF  drop EXIT  THEN
   3 cells - hashsearch over cell+ ! dup      insRule @ >r  insRule off  hash-alloc
   BEGIN  @ dup  WHILE  2dup swap (reveal  REPEAT      3 cells - hashsearch over cell+ ! dup
   2drop  r> insRule ! ;      BEGIN  @ dup  WHILE  2dup swap (reveal  REPEAT
       2drop  r> insRule ! ;
   
 ' (initvoc IS 'initvoc  ' (initvoc IS 'initvoc
   
 : addall  ( -- )  voclink  : addall  ( -- )
   BEGIN  @ dup @  WHILE  dup (initvoc  REPEAT  drop ;      voclink
       BEGIN  @ dup @  WHILE  dup (initvoc  REPEAT  drop ;
   
 \ Hash-Find                                            01jan93py  \ Hash-Find                                            01jan93py
   
Line 74  addall          \ Baum aufbauen Line 80  addall          \ Baum aufbauen
              dup cell+ @ .name  REPEAT  drop               dup cell+ @ .name  REPEAT  drop
   LOOP  drop r> base ! ;    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 - ;

Removed from v.1.1  
changed lines
  Added in v.1.2


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>