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 ! ; |