From 2f83a0bea9da444e3d70569eba3d6847ca02be03 Mon Sep 17 00:00:00 2001 From: Dimitri Sokolyuk Date: Fri, 21 Sep 2018 21:59:17 +0200 Subject: ... --- forth/forth/jmptbl-test.fs | 70 ++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 70 insertions(+) create mode 100644 forth/forth/jmptbl-test.fs (limited to 'forth/forth/jmptbl-test.fs') diff --git a/forth/forth/jmptbl-test.fs b/forth/forth/jmptbl-test.fs new file mode 100644 index 0000000..a49b1d9 --- /dev/null +++ b/forth/forth/jmptbl-test.fs @@ -0,0 +1,70 @@ +\ ********************************************************************* +\ * +\ Filename: jmptbl-test.txt * +\ FlashForth: 5.0 * +\ * +\ Author: Pete Zawasky * +\ Created: Tuesday, January 15 2008 - 18:50 ppz * +\ Last Edit Tuesday, January 29 2008 - 12:25 ppz * +\ * +\ ********************************************************************* +\ Based on jt.fth by Mikael Nordman, Jump_Table by Haskell * +\ ********************************************************************* +\ FlashForth is licensed acording to the GNU General Public License * +\ ********************************************************************* + +hex + +\ 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 +\ + +\ ********************************************************************* +hex ram + +: .1st ( -- ) + ." First " +; + +: .2nd ( -- ) + ." Second " +; + +: .3rd ( -- ) + ." Third " +; + +: .4th ( -- ) + ." Default " +; + +jumptable do_test + $00 | .1st + $01 | .2nd + $02 | .3rd + default| .4th + +ram +1 do_test +2 do_test +9 do_test + +\ 1 do_test Second ok <16,2> +\ 2 do_test Third ok <16,2> +\ 9 do_test Default ok <16,2> + + -- cgit v1.2.3