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 ) |