3 \ this code implements an fcode evaluator
4 \ as described in IEEE 1275-1994
6 \ Copyright (C) 2003 Stefan Reinauer
8 \ See the file "COPYING" for further information about
9 \ the copyright and warranty status of this work.
12 defer init-fcode-table
15 4096 cells alloc-mem to fcode-table
17 ." fcode-table at 0x" fcode-table . cr
23 fcode-table 4096 cells free-mem
27 : (debug-feval) ( fcode# -- fcode# )
29 fcode-stream 1 - . ." : "
31 \ Indicate if word is compiled
35 dup fcode>xt cell - lfa2name type
36 dup ." [ 0x" . ." ]" cr
46 dup flags? 0<> state @ 0= or if
53 \ If we've executed incorrect FCode we may have reached the end of the FCode
54 \ program but still be in compile mode. Make sure that if this has happened
55 \ then we switch back to immediate mode to prevent internal OpenBIOS errors.
56 tmp-comp-depth @ -1 <> if
58 tmp-comp-buf @ @ here!
63 : byte-load ( addr xt -- )
65 cr ." byte-load: evaluating fcode at 0x" over . cr
69 >r >r fcode-push-state r> r>
72 dup 1 = if drop ['] c@ then \ FIXME: uses c@ rather than rb@ for now...
74 dup to fcode-stream-start
77 false to ?fcode-offset16
81 \ protect against stack overflow/underflow
85 cr ." byte-load: exception caught!" cr
88 s" fcode-debug?" evaluate if
90 cr ." byte-load: warning stack overflow, diff " depth r@ - . cr