mirror of
https://gitlab.com/qemu-project/openbios.git
synced 2024-02-13 08:34:06 +08:00
7948face2b
git-svn-id: svn://coreboot.org/openbios/trunk/openbios-devel@484 f158a5a8-5612-0410-a976-696ce0be7e32
90 lines
1.6 KiB
Forth
90 lines
1.6 KiB
Forth
\ tag: FCode evaluator
|
|
\
|
|
\ this code implements an fcode evaluator
|
|
\ as described in IEEE 1275-1994
|
|
\
|
|
\ Copyright (C) 2003 Stefan Reinauer
|
|
\
|
|
\ See the file "COPYING" for further information about
|
|
\ the copyright and warranty status of this work.
|
|
\
|
|
|
|
defer init-fcode-table
|
|
|
|
: alloc-fcode-table
|
|
4096 cells alloc-mem to fcode-table
|
|
?fcode-verbose if
|
|
." fcode-table at 0x" fcode-table . cr
|
|
then
|
|
init-fcode-table
|
|
;
|
|
|
|
: free-fcode-table
|
|
fcode-table 4096 cells free-mem
|
|
0 to fcode-table
|
|
;
|
|
|
|
: (debug-feval) ( fcode# -- fcode# )
|
|
\ Address
|
|
fcode-stream 1 - . ." : "
|
|
|
|
\ Indicate if word is compiled
|
|
state @ 0<> if
|
|
." (compile) "
|
|
then
|
|
dup fcode>xt cell - lfa2name type
|
|
dup ." [ 0x" . ." ]" cr
|
|
;
|
|
|
|
: (feval) ( -- ?? )
|
|
begin
|
|
fcode#
|
|
?fcode-verbose if
|
|
(debug-feval)
|
|
then
|
|
fcode>xt
|
|
dup flags? 0<> state @ 0= or if
|
|
execute
|
|
else
|
|
,
|
|
then
|
|
fcode-end @ until
|
|
;
|
|
|
|
: byte-load ( addr xt -- )
|
|
?fcode-verbose if
|
|
cr ." byte-load: evaluating fcode at 0x" over . cr
|
|
then
|
|
|
|
\ save state
|
|
>r >r fcode-push-state r> r>
|
|
|
|
\ set fcode-c@ defer
|
|
dup 1 = if drop ['] c@ then \ FIXME: uses c@ rather than rb@ for now...
|
|
to fcode-c@
|
|
dup to fcode-stream-start
|
|
to fcode-stream
|
|
1 to fcode-spread
|
|
false to ?fcode-offset16
|
|
alloc-fcode-table
|
|
false fcode-end !
|
|
|
|
\ protect against stack overflow/underflow
|
|
0 0 0 0 0 0 depth >r
|
|
|
|
['] (feval) catch if
|
|
cr ." byte-load: exception caught!" cr
|
|
then
|
|
|
|
depth r@ <> if
|
|
cr ." byte-load: stack overflow, diff " depth r@ - . cr
|
|
then
|
|
|
|
r> depth! 3drop 3drop
|
|
|
|
free-fcode-table
|
|
|
|
\ restore state
|
|
fcode-pop-state
|
|
;
|