feval.fs

来自「BIOS Open Platform!」· FS 代码 · 共 83 行

\ 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# )
  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
;