diff options
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/fcode/core.fs')
| -rw-r--r-- | qemu/roms/SLOF/slof/fs/fcode/core.fs | 173 |
1 files changed, 0 insertions, 173 deletions
diff --git a/qemu/roms/SLOF/slof/fs/fcode/core.fs b/qemu/roms/SLOF/slof/fs/fcode/core.fs deleted file mode 100644 index 8fd98ec19..000000000 --- a/qemu/roms/SLOF/slof/fs/fcode/core.fs +++ /dev/null @@ -1,173 +0,0 @@ -\ ***************************************************************************** -\ * Copyright (c) 2004, 2008 IBM Corporation -\ * All rights reserved. -\ * This program and the accompanying materials -\ * are made available under the terms of the BSD License -\ * which accompanies this distribution, and is available at -\ * http://www.opensource.org/licenses/bsd-license.php -\ * -\ * Contributors: -\ * IBM Corporation - initial implementation -\ ****************************************************************************/ - -: ?offset16 ( -- true|false ) - fcode-offset 2 = - ; - -: ?arch64 ( -- true|false ) - cell 8 = - ; - -: ?bigendian ( -- true|false ) - deadbeef fcode-num ! - fcode-num ?arch64 IF 4 + THEN - c@ de = - ; - -: reset-fcode-end ( -- ) - false fcode-end ! - ; - -: get-ip ( -- n ) - ip @ - ; - -: set-ip ( n -- ) - ip ! - ; - -: next-ip ( -- ) - get-ip 1+ set-ip - ; - -: jump-n-ip ( n -- ) - get-ip + set-ip - ; - -: read-byte ( -- n ) - get-ip fcode-rb@ - ; - -: ?compile-mode ( -- on|off ) - state @ - ; - -: save-evaluator-state - get-ip eva-debug? IF ." saved ip " dup . cr THEN - fcode-end @ eva-debug? IF ." saved fcode-end " dup . cr THEN - fcode-offset eva-debug? IF ." saved fcode-offset " dup . cr THEN -\ local fcodes are currently NOT saved! - fcode-spread eva-debug? IF ." saved fcode-spread " dup . cr THEN - ['] fcode@ behavior eva-debug? IF ." saved fcode@ " dup . cr THEN - ; - -: restore-evaluator-state - eva-debug? IF ." restored fcode@ " dup . cr THEN to fcode@ - eva-debug? IF ." restored fcode-spread " dup . cr THEN to fcode-spread -\ local fcodes are currently NOT restored! - eva-debug? IF ." restored fcode-offset " dup . cr THEN to fcode-offset - eva-debug? IF ." restored fcode-end " dup . cr THEN fcode-end ! - eva-debug? IF ." restored ip " dup . cr THEN set-ip - ; - -: token-table-index ( fcode# -- addr ) - cells token-table + - ; - -: join-immediate ( xt immediate? addr -- xt+immediate? addr ) - -rot + swap - ; - -: split-immediate ( xt+immediate? -- xt immediate? ) - dup 1 and 2dup - rot drop swap - ; - -: literal, ( n -- ) - postpone literal - ; - -: fc-string, - postpone sliteral - dup c, bounds ?do i c@ c, loop - ; - -: set-token ( xt immediate? fcode# -- ) - token-table-index join-immediate ! - ; - -: get-token ( fcode# -- xt immediate? ) - token-table-index @ split-immediate - ; - -( ---------------------------------------------------- ) - -#include "little-big.fs" - -( ---------------------------------------------------- ) - -: read-fcode# ( -- FCode# ) - read-byte - dup 01 0F between IF drop read-fcode-num16 THEN - ; - -: read-header ( adr -- ) - next-ip read-byte drop - next-ip read-fcode-num16 drop - next-ip read-fcode-num32 drop - ; - -: read-fcode-string ( -- str len ) - read-byte \ get string length ( -- len ) - next-ip get-ip \ get string addr ( -- len str ) - swap \ type needs the parameters swapped ( -- str len ) - dup 1- jump-n-ip \ jump to the end of the string in FCode - ; - - --1 VALUE break-fcode-addr -0 VALUE break-fcode-steps - -: evaluate-fcode ( -- ) - BEGIN - get-ip break-fcode-addr = IF - TRUE fcode-end ! - THEN - fcode-end @ 0= - WHILE - fcode@ ( fcode# ) - eva-debug? IF - dup - get-ip 8 u.r ." : " - ." [" 3 u.r ." ] " - THEN - \ When it is not immediate and in compile-mode, then compile - get-token 0= ?compile-mode AND IF ( xt ) - compile, - ELSE \ immediate or "interpretation" mode - eva-debug? IF dup xt>name type space THEN - execute - THEN - eva-debug? IF .s cr THEN - break-fcode-steps IF - break-fcode-steps 1- TO break-fcode-steps - break-fcode-steps 0= IF - TRUE fcode-end ! - THEN - THEN - next-ip - REPEAT -; - -\ Run FCODE for n steps -: steps-fcode ( n -- ) - to break-fcode-steps - break-fcode-addr >r -1 to break-fcode-addr - reset-fcode-end - evaluate-fcode - r> to break-fcode-addr -; - -\ Step through one FCODE instruction -: step-fcode ( -- ) - 1 steps-fcode -; |