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

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

version 1.4, 1994/06/16 17:08:41 version 1.5, 1994/07/21 10:52:51
Line 2 Line 2
   
 $10 constant maxvp  $10 constant maxvp
 Variable vp  Variable vp
   0 A, 0 A,   0 A, 0 A,   0 A, 0 A,   0 A, 0 A,     0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
   0 A, 0 A,   0 A, 0 A,   0 A, 0 A,   0 A, 0 A,     0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
   
 : get-current  ( -- wid )  current @ ;  : get-current  ( -- wid )  current @ ;
 : set-current  ( wid -- )  current ! ;  : set-current  ( wid -- )  current ! ;
Line 11  Variable vp Line 11  Variable vp
 : context ( -- addr )  vp dup @ cells + ;  : context ( -- addr )  vp dup @ cells + ;
 : definitions  ( -- )  context @ current ! ;  : definitions  ( -- )  context @ current ! ;
   
 \ hash search                                          29may94py  
   
 \ uses a direct hash mapped cache --- idea from Heinz Schnitter  
   
 \ : hashkey ( addr count -- key )  
 \   swap c@ toupper 3 * + $3F and ; \ gives a simple hash key  
   
 \ Variable hits  
 \ Variable fails  
   
 \ : hash-find  ( addr count wid -- nfa / false )  
 \   >r  2dup hashkey  
 \   cells r@ 3 cells + @ +           \ hashed addr  
 \   dup @  
 \   IF  >r r@ @ cell+ c@ over =  
 \       IF  2dup r@ @ cell+ char+ capscomp 0=  
 \           IF  2drop r> @ rdrop  1 hits +!  EXIT  THEN  THEN  
 \       r>  
 \   THEN  r> swap >r @ (f83casefind)  dup  
 \   IF  dup r@ !  THEN  rdrop  1 fails +! ;  
   
 \ : hash-reveal ( -- )  
 \   last?  
 \   IF  dup cell+ count hashkey cells  
 \       current @ 3 cells + @ + !  
 \       (reveal)  
 \   THEN ;  
   
 \ : clear-hash ( wid -- )  3 cells + @ $40 cells erase ;  
   
 \ Create hashsearch  
 \ ' hash-find A,  ' hash-reveal A,  ' clear-hash A,  
   
 \ for testing  
   
 \ : .hash ( wid -- )  3 cells + @ ?dup 0= ?EXIT  cr  
 \   8 0 DO  
 \           8 0 DO  dup I J 8 * + cells + @ dup  
 \                 IF    cell+ count $1F and tuck 10 min type  
 \                       10 swap - spaces  
 \                 ELSE  drop  10 spaces  THEN  
 \         LOOP  
 \   LOOP  drop ;  
   
 \ wordlist Vocabulary also previous                    14may93py  \ wordlist Vocabulary also previous                    14may93py
   
 AVariable voclink  AVariable voclink
   
   Defer 'initvoc
   ' drop IS 'initvoc
   
   Variable slowvoc   slowvoc off
   
 : wordlist  ( -- wid )  : wordlist  ( -- wid )
   here  0 A, f83search ( hashsearch ) A, voclink @ A,    here  0 A, Forth-wordlist cell+ @ A, voclink @ A, slowvoc @ A,
   ( here cell+ ) 0 A, \ here $40 cells dup allot erase    dup 2 cells + dup voclink ! 'initvoc ;
   dup 2 cells + voclink ! ;  
   
 : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;  : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
   
Line 74  AVariable voclink Line 34  AVariable voclink
   
 \ vocabulary find                                      14may93py  \ vocabulary find                                      14may93py
   
 : (vocfind)  ( addr count wid -- nfa2|false )  : (vocfind)  ( addr count nfa1 -- nfa2|false )
     \ !! generalize this to be independent of vp      \ !! generalize this to be independent of vp
     drop 1 vp @      drop 1 vp @
     DO  2dup vp I cells + @ (search-wordlist) dup      DO  2dup vp I cells + @ (search-wordlist) dup
Line 86  AVariable voclink Line 46  AVariable voclink
   
 0 value locals-wordlist  0 value locals-wordlist
   
 : (localsvocfind)  ( addr count wid -- nfa2|false )  : (localsvocfind)  ( addr count nfa1 -- nfa2|false )
     \ !! use generalized (vocfind)      \ !! use generalized (vocfind)
     drop locals-wordlist      drop locals-wordlist
     IF 2dup locals-wordlist (search-wordlist) dup      IF 2dup locals-wordlist (search-wordlist) dup
Line 102  AVariable voclink Line 62  AVariable voclink
 \  (including locals)  \  (including locals)
   
 \ this is the wordlist-map of the dictionary  \ this is the wordlist-map of the dictionary
 Create vocsearch  Create vocsearch       ' (localsvocfind) A, ' (reveal) A,  ' drop A,
        ' (localsvocfind) A, ' (reveal) A,  ' drop A,  
   
 \ Only root                                            14may93py  \ Only root                                            14may93py
   
Line 123  Only Forth also definitions Line 82  Only Forth also definitions
   
 search A! \ our dictionary search order becomes the law  search A! \ our dictionary search order becomes the law
   
 ' Forth >body AConstant Forth-wordlist  
   
 \ get-order set-order                                  14may93py  \ get-order set-order                                  14may93py
   
 : get-order  ( -- wid1 .. widn n )  : get-order  ( -- wid1 .. widn n )
Line 157  Root definitions Line 114  Root definitions
 ' Forth Alias Forth  ' Forth Alias Forth
   
 Forth definitions  Forth definitions
   
   [IFDEF] (hashkey) include hash.fs [THEN]
Removed from v.1.4  
changed lines
  Added in v.1.5

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