diff options
Diffstat (limited to 'qemu/roms/openbios/forth/bootstrap/interpreter.fs')
| -rw-r--r-- | qemu/roms/openbios/forth/bootstrap/interpreter.fs | 175 |
1 files changed, 175 insertions, 0 deletions
diff --git a/qemu/roms/openbios/forth/bootstrap/interpreter.fs b/qemu/roms/openbios/forth/bootstrap/interpreter.fs new file mode 100644 index 000000000..51870581f --- /dev/null +++ b/qemu/roms/openbios/forth/bootstrap/interpreter.fs @@ -0,0 +1,175 @@ +\ tag: forth interpreter +\ +\ Copyright (C) 2003 Stefan Reinauer +\ +\ See the file "COPYING" for further information about +\ the copyright and warranty status of this work. +\ + + +\ +\ 7.3.4.6 Display pause +\ + +0 value interactive? +0 value terminate? + +: exit? + interactive? 0= if + false exit + then + false \ FIXME we should check whether to interrupt output + \ and ask the user how to proceed. + ; + + +\ +\ 7.3.9.1 Defining words +\ + +: forget + s" This word is obsolescent." type cr + ['] ' execute + cell - dup + @ dup + last ! latest ! + here! + ; + +\ +\ 7.3.9.2.4 Miscellaneous dictionary +\ + +\ interpreter. This word checks whether the interpreted word +\ is a word in dictionary or a number. It honours compile mode +\ and immediate/compile-only words. + +: interpret + 0 >in ! + begin + parse-word dup 0> \ was there a word at all? + while + $find + if + dup flags? 0<> state @ 0= or if + execute + else + , \ compile mode && !immediate + then + else \ word is not known. maybe it's a number + 2dup $number + if + span @ >in ! \ if we encountered an error, don't continue parsing + type 3a emit + -13 throw + else + -rot 2drop 1 handle-lit + then + then + depth 200 >= if -3 throw then + depth 0< if -4 throw then + rdepth 200 >= if -5 throw then + rdepth 0< if -6 throw then + repeat + 2drop + ; + +: refill ( -- ) + ib #ib @ expect 0 >in ! ; + +: print-status ( exception -- ) + space + ?dup if + dup sys-debug \ system debug hook + case + -1 of s" Aborted." type endof + -2 of s" Aborted." type endof + -3 of s" Stack Overflow." type 0 depth! endof + -4 of s" Stack Underflow." type 0 depth! endof + -5 of s" Return Stack Overflow." type endof + -6 of s" Return Stack Underflow." type endof + -13 of s" undefined word." type endof + -15 of s" out of memory." type endof + -21 of s" undefined method." type endof + -22 of s" no such device." type endof + dup s" Exception #" type . + 0 state ! + endcase + else + state @ 0= if + s" ok" + else + s" compiled" + then + type + then + cr + ; + +defer status +['] noop ['] status (to) + +: print-prompt + status + depth . 3e emit space + ; + +defer outer-interpreter +:noname + cr + begin + print-prompt + source 0 fill \ clean input buffer + refill + + ['] interpret catch print-status + terminate? + until +; ['] outer-interpreter (to) + +\ +\ 7.3.8.5 Other control flow commands +\ + +: save-source ( -- ) + r> \ fetch our caller + ib >r #ib @ >r \ save current input buffer + source-id >r \ and all variables + span @ >r \ associated with it. + >in @ >r + >r \ move back our caller + ; + +: restore-source ( -- ) + r> + r> >in ! + r> span ! + r> ['] source-id (to) + r> #ib ! + r> ['] ib (to) + >r + ; + +: (evaluate) ( str len -- ??? ) + save-source + -1 ['] source-id (to) + dup + #ib ! span ! + ['] ib (to) + interpret + restore-source + ; + +: evaluate ( str len -- ?? ) + 2dup + -rot + over + over do + i c@ 0a = if + i over - + (evaluate) + i 1+ + then + loop + swap over - (evaluate) + ; + +: eval evaluate ; |