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

version 1.2, 1994/05/07 14:56:06 version 1.3, 1994/06/01 10:05:21
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
   
 : wordlist  ( -- wid )  : wordlist  ( -- wid )
   here  0 A, Forth-wordlist cell+ @ A, voclink @ A, 0 A,    here  0 A, hashsearch A, voclink @ A,
     here cell+ 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 ! ;
Line 29  AVariable voclink Line 74  AVariable voclink
   
 \ vocabulary find                                      14may93py  \ vocabulary find                                      14may93py
   
 : (vocfind)  ( addr count nfa1 -- nfa2|false )  : (vocfind)  ( addr count wid -- 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 41  AVariable voclink Line 86  AVariable voclink
   
 0 value locals-wordlist  0 value locals-wordlist
   
 : (localsvocfind)  ( addr count nfa1 -- nfa2|false )  : (localsvocfind)  ( addr count wid -- 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 57  AVariable voclink Line 102  AVariable voclink
 \  (including locals)  \  (including locals)
   
 \ this is the wordlist-map of the dictionary  \ this is the wordlist-map of the dictionary
 Create vocsearch       ' (localsvocfind) A, ' (reveal) A,  Create vocsearch
          ' (localsvocfind) A, ' (reveal) A,  ' drop A,
   
 \ Only root                                            14may93py  \ Only root                                            14may93py
   
Line 77  Only Forth also definitions Line 123  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 )

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


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