mirror of
https://github.com/nineties/planckforth
synced 2025-01-13 08:01:10 +01:00
Wrote 4th stage interpreter
This commit is contained in:
parent
de3584b1d5
commit
6ea40bd3dc
1 changed files with 92 additions and 16 deletions
108
bootstrap.fs
108
bootstrap.fs
|
@ -1347,6 +1347,7 @@ main
|
|||
( === File I/O Abstraction === )
|
||||
|
||||
decimal
|
||||
-39 s" Unexpected end of file" def-error UNEXPECTED-EOF-ERROR
|
||||
-68 s" FLUSH-FILE" def-error FLUSH-FILE-ERROR
|
||||
-70 s" READ-FILE" def-error READ-FILE-ERROR
|
||||
-71 s" READ-LINE" def-error READ-LINE-ERROR
|
||||
|
@ -1505,13 +1506,15 @@ variable inputstreams
|
|||
|
||||
stdin_ push-inputstream
|
||||
|
||||
\ Rewrite existing functions that reads input using inputstream.
|
||||
\ Rewrite existing functions that reads inputs using inputstream.
|
||||
|
||||
: key ( -- c )
|
||||
inputstreams @ input>file @ key-file
|
||||
;
|
||||
|
||||
: word ( -- c-addr )
|
||||
\ Read a word from input stream, return address of the string
|
||||
\ and error-code.
|
||||
: word ( -- c-addr e )
|
||||
inputstreams @ input>file @
|
||||
\ skip leading spaces
|
||||
0
|
||||
|
@ -1520,6 +1523,9 @@ stdin_ push-inputstream
|
|||
dup key-file \ ( file c )
|
||||
dup bl <> over '\n' <> and
|
||||
until
|
||||
dup EOF = if
|
||||
drop word-buffer UNEXPECTED-EOF-ERROR
|
||||
then
|
||||
word-buffer tuck c!
|
||||
1+
|
||||
begin
|
||||
|
@ -1528,20 +1534,20 @@ stdin_ push-inputstream
|
|||
dup bl = over '\n' = or if
|
||||
drop
|
||||
0 swap c! \ store \0
|
||||
drop
|
||||
word-buffer exit
|
||||
drop word-buffer success
|
||||
exit
|
||||
then
|
||||
over c!
|
||||
1+
|
||||
again
|
||||
;
|
||||
|
||||
: ' ( "name" -- xt ) word find >cfa ;
|
||||
: ' ( "name" -- xt ) word throw find >cfa ;
|
||||
|
||||
: : ( "name -- )
|
||||
align
|
||||
here latest , &latest !
|
||||
word dup strlen
|
||||
word throw dup strlen
|
||||
smudge-bit or c,
|
||||
strcpy,
|
||||
align
|
||||
|
@ -1549,18 +1555,10 @@ stdin_ push-inputstream
|
|||
]
|
||||
;
|
||||
|
||||
: ; ( -- )
|
||||
align
|
||||
compile exit
|
||||
latest cell + dup c@
|
||||
smudge-bit invert and swap c!
|
||||
[compile] [
|
||||
; immediate
|
||||
|
||||
: create ( "name" -- )
|
||||
align
|
||||
here latest , &latest !
|
||||
word dup strlen c, strcpy,
|
||||
word throw dup strlen c, strcpy,
|
||||
align
|
||||
docol ,
|
||||
compile lit
|
||||
|
@ -1569,6 +1567,84 @@ stdin_ push-inputstream
|
|||
compile exit
|
||||
;
|
||||
|
||||
: char ( "ccc" -- c ) word c@ ;
|
||||
|
||||
: char ( "ccc" -- c ) word throw c@ ;
|
||||
|
||||
( === 4th Stage Interpreter === )
|
||||
|
||||
-56 s" Bye" def-error QUIT
|
||||
|
||||
: interpret
|
||||
word case \ read name from input
|
||||
|
||||
\ EOF check
|
||||
success of ( ok ) endof
|
||||
UNEXPECTED-EOF-ERROR of QUIT throw endof
|
||||
throw ( rethrow other errors )
|
||||
endcase
|
||||
|
||||
dup word-buffer strcpy \ save input
|
||||
dup find \ lookup dictionary
|
||||
?dup if
|
||||
\ Found the word
|
||||
swap drop
|
||||
state @ if
|
||||
\ compile mode
|
||||
dup cell+ c@ immediate-bit and if
|
||||
\ execute immediate word
|
||||
>cfa execute
|
||||
else
|
||||
\ compile the word
|
||||
>cfa ,
|
||||
then
|
||||
else
|
||||
\ immediate mode
|
||||
>cfa execute
|
||||
then
|
||||
else
|
||||
>number unless
|
||||
UNDEFINED-WORD-ERROR throw
|
||||
then
|
||||
\ Not found
|
||||
state @ if
|
||||
\ compile mode
|
||||
[compile] literal
|
||||
then
|
||||
then
|
||||
;
|
||||
|
||||
: interpret-loop
|
||||
begin
|
||||
['] interpret catch
|
||||
?dup if
|
||||
\ lookup error code
|
||||
dup QUIT = if throw then
|
||||
error-list @
|
||||
begin ?dup while
|
||||
\ ( error-code error-entry )
|
||||
dup error>code
|
||||
2 pick = if
|
||||
error>message type
|
||||
." : "
|
||||
word-buffer type cr
|
||||
bye
|
||||
then
|
||||
error>next
|
||||
repeat
|
||||
." Unknown error code: " . cr
|
||||
bye
|
||||
then
|
||||
again
|
||||
;
|
||||
|
||||
: switch-to-4th-stage
|
||||
rdrop \ drop 3rd stage
|
||||
|
||||
['] interpret-loop catch
|
||||
|
||||
bye
|
||||
;
|
||||
|
||||
switch-to-4th-stage
|
||||
|
||||
." Ready" cr
|
||||
|
|
Loading…
Reference in a new issue