177 lines
3.2 KiB
Forth
177 lines
3.2 KiB
Forth
\ 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@ dup 0a = swap 0d = or if
|
|
i over -
|
|
rot >r
|
|
(evaluate)
|
|
r>
|
|
i 1+
|
|
then
|
|
loop
|
|
swap over - (evaluate)
|
|
;
|
|
|
|
: eval evaluate ;
|