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     ! 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.