mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-11-26 17:49:18 +00:00
86 lines
5.2 KiB
Forth
86 lines
5.2 KiB
Forth
|
\ *** Block No. 0 Hexblock 0
|
||
|
|
\ HashCash Suchalgorithmus UH 11Nov86
|
||
|
|
|
||
|
|
Ein Algorithmus, der die Dictionarysuche beschleunigt:
|
||
|
|
Zuerst wird uebr das gesucht Wort gehasht und in in einer
|
||
|
|
Tabelle nachgesehen. Schlaegt der Versuch fehl, wird ganz normal
|
||
|
|
gesucht. Suchzeit geht auf ca. 70-80% gegenueber normalem Suchen
|
||
|
|
herunter.
|
||
|
|
|
||
|
|
Hinzu kommen die Worte:
|
||
|
|
cash, hash-thread, erase-cash, 'cash, und found?
|
||
|
|
|
||
|
|
Im Kernal neudefiniert oder gepatched werden muessen:
|
||
|
|
(find, hide, reveal, forget-words
|
||
|
|
|
||
|
|
(find und (forget benutzen jejweils die alten Worte. Sie muessen
|
||
|
|
umbenannt oder in die neuen Worte eingebettet werden.
|
||
|
|
\ *** Block No. 1 Hexblock 1
|
||
|
|
\ Hash Cash fuer volksFORTH UH 11Nov86
|
||
|
|
|
||
|
|
Create cash $200 allot
|
||
|
|
|
||
|
|
' Forth >body Constant hash-thread
|
||
|
|
: erase-cash ( -- ) cash $200 erase ; erase-cash
|
||
|
|
|
||
|
|
1 3 +thru
|
||
|
|
|
||
|
|
patch (find
|
||
|
|
( patch forget-words ) ' forget-words \ forget-words
|
||
|
|
dup ' clear >body 6 + ! \ liegt auf einer ungluecklichen
|
||
|
|
dup ' (forget >body $12 + ! \ Adresse, sodass das automa-
|
||
|
|
dup ' empty >body 8 + ! \ tische Patchen nicht klappt.
|
||
|
|
' save >body 4+ !
|
||
|
|
patch hide patch reveal forget (patch save
|
||
|
|
\ *** Block No. 2 Hexblock 2
|
||
|
|
\ 'cash found? hfind UH 23Oct86
|
||
|
|
|
||
|
|
: 'cash ( nfa -- 'cash )
|
||
|
|
count $1F and under bounds
|
||
|
|
?DO I c@ + LOOP $FF and 2* cash + ;
|
||
|
|
|
||
|
|
: found? ( str nfa -- f )
|
||
|
|
count rot count rot over = IF swap -text 0= exit THEN
|
||
|
|
drop 2drop false ;
|
||
|
|
|
||
|
|
: (find ( str thread -- str false | nfa true )
|
||
|
|
dup hash-thread - IF (find exit THEN
|
||
|
|
drop dup 'cash @ 2dup found? IF nip true exit THEN
|
||
|
|
drop hash-thread (find dup 0= ?exit over dup 'cash ! ;
|
||
|
|
|
||
|
|
|
||
|
|
\ *** Block No. 3 Hexblock 3
|
||
|
|
\ Kernal changes UH 23Oct86
|
||
|
|
|
||
|
|
' hide >body @ | Alias last?
|
||
|
|
|
||
|
|
: hide last? IF 0 over 'cash ! 2- @ current @ ! THEN ;
|
||
|
|
|
||
|
|
: reveal last? IF dup dup 'cash ! 2- current @ ! THEN ;
|
||
|
|
|
||
|
|
' clear >body 6 + @ | Alias forget-words
|
||
|
|
|
||
|
|
| : forget-words erase-cash forget-words ;
|
||
|
|
|
||
|
|
: .cash cash $200 bounds DO I @ ?dup IF .name THEN 2 +LOOP ;
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
\ *** Block No. 4 Hexblock 4
|
||
|
|
\ patching UH 23Oct86
|
||
|
|
|
||
|
|
: (patch ( new old -- )
|
||
|
|
['] cash 0 DO
|
||
|
|
i @ over = IF cr I u. over I ! THEN LOOP 2drop ;
|
||
|
|
|
||
|
|
: patch \ name
|
||
|
|
>in @ ' swap >in ! dup >name 2- context push context ! '
|
||
|
|
(patch ;
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
|