[BACK]Return to search-order.fs CVS log [TXT] [DIR] Up to [gforth] / gforth

Diff for /gforth/Attic/search-order.fs between versions 1.3 and 1.4

version 1.3, 1994/06/01 10:05:21 version 1.4, 1994/06/16 17:08:41
Line 15  Variable vp Line 15  Variable vp
   
 \ uses a direct hash mapped cache --- idea from Heinz Schnitter  \ uses a direct hash mapped cache --- idea from Heinz Schnitter
   
 : hashkey ( addr count -- key )  \ : hashkey ( addr count -- key )
   swap c@ toupper 3 * + $3F and ; \ gives a simple hash key  \   swap c@ toupper 3 * + $3F and ; \ gives a simple hash key
   
 Variable hits  \ Variable hits
 Variable fails  \ Variable fails
   
 : hash-find  ( addr count wid -- nfa / false )  \ : hash-find  ( addr count wid -- nfa / false )
   >r  2dup hashkey  \   >r  2dup hashkey
   cells r@ 3 cells + @ +           \ hashed addr  \   cells r@ 3 cells + @ +           \ hashed addr
   dup @  \   dup @
   IF  >r r@ @ cell+ c@ over =  \   IF  >r r@ @ cell+ c@ over =
       IF  2dup r@ @ cell+ char+ capscomp 0=  \       IF  2dup r@ @ cell+ char+ capscomp 0=
           IF  2drop r> @ rdrop  1 hits +!  EXIT  THEN  THEN  \           IF  2drop r> @ rdrop  1 hits +!  EXIT  THEN  THEN
       r>  \       r>
   THEN  r> swap >r @ (f83casefind)  dup  \   THEN  r> swap >r @ (f83casefind)  dup
   IF  dup r@ !  THEN  rdrop  1 fails +! ;  \   IF  dup r@ !  THEN  rdrop  1 fails +! ;
   
 : hash-reveal ( -- )  \ : hash-reveal ( -- )
   last?  \   last?
   IF  dup cell+ count hashkey cells  \   IF  dup cell+ count hashkey cells
       current @ 3 cells + @ + !  \       current @ 3 cells + @ + !
       (reveal)  \       (reveal)
   THEN ;  \   THEN ;
   
 : clear-hash ( wid -- )  3 cells + @ $40 cells erase ;  \ : clear-hash ( wid -- )  3 cells + @ $40 cells erase ;
   
 Create hashsearch  \ Create hashsearch
   ' hash-find A,  ' hash-reveal A,  ' clear-hash A,  \ ' hash-find A,  ' hash-reveal A,  ' clear-hash A,
   
 \ for testing  \ for testing
   
 : .hash ( wid -- )  3 cells + @ ?dup 0= ?EXIT  cr  \ : .hash ( wid -- )  3 cells + @ ?dup 0= ?EXIT  cr
   8 0 DO  \   8 0 DO
           8 0 DO  dup I J 8 * + cells + @ dup  \           8 0 DO  dup I J 8 * + cells + @ dup
                   IF    cell+ count $1F and tuck 10 min type  \                 IF    cell+ count $1F and tuck 10 min type
                         10 swap - spaces  \                       10 swap - spaces
                   ELSE  drop  10 spaces  THEN  \                 ELSE  drop  10 spaces  THEN
           LOOP  \         LOOP
   LOOP  drop ;  \   LOOP  drop ;
   
 \ wordlist Vocabulary also previous                    14may93py  \ wordlist Vocabulary also previous                    14may93py
   
 AVariable voclink  AVariable voclink
   
 : wordlist  ( -- wid )  : wordlist  ( -- wid )
   here  0 A, hashsearch A, voclink @ A,    here  0 A, f83search ( hashsearch ) A, voclink @ A,
   here cell+ A,  here $40 cells dup allot erase    ( here cell+ ) 0 A, \ here $40 cells dup allot erase
   dup 2 cells + voclink ! ;    dup 2 cells + voclink ! ;
   
 : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;  : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
Removed from v.1.3  
changed lines
  Added in v.1.4

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