jmptbl.txt

\ *********************************************************************
\                                                                     *
\    Filename:      jmptbl.txt                                        *
\    FlashForth:    3.8                                               *
\    MCU            PIC18F                                            *
\    Application:                                                     *
\                                                                     *
\    Author:        Pete Zawasky                                      *
\    Created:       10:34 AM 10/5/2011   ppz                          *
\    Last Edit                 ppz                                    *
\                                                                     *
\ *********************************************************************
\  Based on jt.fth by Mikael Nordman, Jump_Table by Haskell           *
\ *********************************************************************
\  FlashForth is licensed acording to the GNU General Public License  *
\ *********************************************************************

-jmptbl
marker -jmptbl

decimal ram

\ Create an execution table with n entries.
\ Each entry consists of 'nn' cell sized comparison value
\   and 'an' the address of the corresponding word to be executed.
\ At least two entries must be provided, the last one being the
\   default action.
\
\ Jump Table (from Haskell)
\ Example:
\
\    JUMP_TABLE do.key
\               control H  |  bkspace
\               control Q  |  quit
\               HEX 2B     |  escape  DECIMAL
\                   DEFAULT|  chrout
\ Useage:
\    do.key  ( n -- )   \ enter with n=code-to-match on TOS
\

\ Create a jump table.
\
: JUMP_TABLE  ( -- )       \ compile an execution table
              ( m -- )     \ execute a word corresponding to m
   create
     [ flash ] here 0 ,    \ initial test_cnt stored at pfa
                           \ ( addr -- )
   does>              \ ( m addr -- )
     dup @            \ ( m a cnt -- )
     for
       cell+
       2dup @ =           \ ( m a flag -- )
       if                 \ a match was found
         nip cell+ @ex    \ execute the matched word
         rdrop exit       \   and exit
       then
       cell+            \ ( m a -- ) point to next nn to test
     next
     nip cell+ @ex      \ execute the default word
   ;

\ Use the words | and default| to fill jump table.
\
: |             ( addr m -- addr )
    , ' ,               \ store m (match) and cfa in table
    1 over +!  ;        \ increment test_cnt at pfa

: default|      ( addr -- )
    drop ' ,  ;         \ store default word cfa in table

\ *********************************************************************
\ Example
\ : .1st    ( -- )
\    ." First "
\    ;
\
\ : .2nd    ( -- )
\    ." Second "
\    ;
\
\ : .3rd    ( -- )
\    ." Third "
\    ;
\
\ : .4th    ( -- )
\    ." Default "
\    ;
\
\ flash
\ JUMP_TABLE do_test
\       $00 | .1st
\       $01 | .2nd
\       $02 | .3rd
\    default| .4th

ram  hex