VolksForth/8080/CPM/hashcash.fb

\ 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 normalgesucht. Suchzeit geht auf ca. 70-80% gegenueber normalem Suchenherunter.                                                                                                                       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 muessenumbenannt oder in die neuen Worte eingebettet werden.           \ 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                \ '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 ! ;                                                                                                                                 \ 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 ;                                                                                                                                                                                                \ 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 ;