Return to feval.fs CVS log

Up to [Qemu by Fabrice Bellard] / qemu / roms / openbios / forth / device

Annotation of qemu/roms/openbios/forth/device/feval.fs, revision 1.1.1.1

1.1       root        1: \ tag: FCode evaluator
                      2: \ 
                      3: \ this code implements an fcode evaluator 
                      4: \ as described in IEEE 1275-1994
                      5: \ 
                      6: \ Copyright (C) 2003 Stefan Reinauer
                      7: \ 
                      8: \ See the file "COPYING" for further information about
                      9: \ the copyright and warranty status of this work.
                     10: \ 
                     11: 
                     12: defer init-fcode-table
                     13: 
                     14: : alloc-fcode-table 
                     15:   4096 cells alloc-mem to fcode-table
                     16:   ?fcode-verbose if
                     17:     ." fcode-table at 0x" fcode-table . cr
                     18:   then
                     19:   init-fcode-table
                     20:   ;
                     21:  
                     22: : free-fcode-table
                     23:   fcode-table 4096 cells free-mem
                     24:   0 to fcode-table
                     25:   ;
                     26: 
                     27: : (debug-feval) ( fcode# -- fcode# )
                     28:   \ Address
                     29:   fcode-stream 1 - . ." : "
                     30: 
                     31:   \ Indicate if word is compiled
                     32:   state @ 0<> if
                     33:     ." (compile) "
                     34:   then
                     35:   dup fcode>xt cell - lfa2name type
                     36:   dup ."  [ 0x" . ." ]" cr
                     37:   ;
                     38: 
                     39: : (feval) ( -- ?? )
                     40:   begin
                     41:     fcode#
                     42:     ?fcode-verbose if
                     43:       (debug-feval)
                     44:     then
                     45:     fcode>xt
                     46:     dup flags? 0<> state @ 0= or if
                     47:       execute
                     48:     else
                     49:       ,
                     50:     then
                     51:   fcode-end @ until
                     52: ;
                     53: 
                     54: : byte-load ( addr xt -- )
                     55:   ?fcode-verbose if
                     56:     cr ." byte-load: evaluating fcode at 0x" over . cr
                     57:   then
                     58: 
                     59:   \ save state
                     60:   >r >r fcode-push-state r> r>
                     61: 
                     62:   \ set fcode-c@ defer
                     63:   dup 1 = if drop ['] c@ then      \ FIXME: uses c@ rather than rb@ for now...
                     64:   to fcode-c@
                     65:   dup to fcode-stream-start
                     66:   to fcode-stream
                     67:   1 to fcode-spread
                     68:   false to ?fcode-offset16 
                     69:   alloc-fcode-table
                     70:   false fcode-end !
                     71:   
                     72:   \ protect against stack overflow/underflow
                     73:   0 0 0 0 0 0 depth >r
                     74:   
                     75:   ['] (feval) catch if
                     76:     cr ." byte-load: exception caught!" cr
                     77:   then
                     78: 
                     79:   s" fcode-debug?" evaluate if
                     80:     depth r@ <> if
                     81:       cr ." byte-load: warning stack overflow, diff " depth r@ - . cr
                     82:     then
                     83:   then
                     84: 
                     85:   r> depth! 3drop 3drop
                     86: 
                     87:   free-fcode-table
                     88: 
                     89:   \ restore state
                     90:   fcode-pop-state
                     91: ;

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.