summaryrefslogtreecommitdiffstats
path: root/qemu/roms/SLOF/slof/fs/fcode
diff options
context:
space:
mode:
authorYang Zhang <yang.z.zhang@intel.com>2015-08-28 09:58:54 +0800
committerYang Zhang <yang.z.zhang@intel.com>2015-09-01 12:44:00 +0800
commite44e3482bdb4d0ebde2d8b41830ac2cdb07948fb (patch)
tree66b09f592c55df2878107a468a91d21506104d3f /qemu/roms/SLOF/slof/fs/fcode
parent9ca8dbcc65cfc63d6f5ef3312a33184e1d726e00 (diff)
Add qemu 2.4.0
Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5 Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>
Diffstat (limited to 'qemu/roms/SLOF/slof/fs/fcode')
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/1275.fs465
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/core.fs173
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/evaluator.fs119
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/little-big.fs96
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/locals.fs155
-rw-r--r--qemu/roms/SLOF/slof/fs/fcode/tokens.fs480
6 files changed, 1488 insertions, 0 deletions
diff --git a/qemu/roms/SLOF/slof/fs/fcode/1275.fs b/qemu/roms/SLOF/slof/fs/fcode/1275.fs
new file mode 100644
index 000000000..c2a67bcc9
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/1275.fs
@@ -0,0 +1,465 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 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
+\ ****************************************************************************/
+
+
+: fcode-revision ( -- n )
+ 00030000 \ major * 65536 + minor
+ ;
+
+: b(lit) ( -- n )
+ next-ip read-fcode-num32
+ ?compile-mode IF literal, THEN
+ ;
+
+: b(")
+ next-ip read-fcode-string
+ ?compile-mode IF fc-string, align postpone count THEN
+ ;
+
+: b(')
+ next-ip read-fcode# get-token drop ?compile-mode IF literal, THEN
+ ;
+
+: ?jump-direction ( n -- )
+ dup 8000 >= IF
+ 10000 - \ Create cell-sized negative value
+ THEN
+ fcode-offset - \ IP is already behind offset, so subtract offset size
+;
+
+: ?negative
+ 8000 and
+ ;
+
+: dest-on-top
+ 0 >r BEGIN dup @ 0= WHILE >r REPEAT
+ BEGIN r> dup WHILE swap REPEAT
+ drop
+ ;
+
+: read-fcode-offset
+ next-ip
+ ?offset16 IF
+ read-fcode-num16
+ ELSE
+ read-byte
+ dup 80 and IF FF00 or THEN \ Fake 16-bit signed offset
+ THEN
+;
+
+: b?branch ( flag -- )
+ ?compile-mode IF
+ read-fcode-offset ?negative IF
+ dest-on-top postpone until
+ ELSE
+ postpone if
+ THEN
+ ELSE
+ ( flag ) IF
+ fcode-offset jump-n-ip \ Skip over offset value
+ ELSE
+ read-fcode-offset
+ ?jump-direction jump-n-ip
+ THEN
+ THEN
+; immediate
+
+: bbranch ( -- )
+ ?compile-mode IF
+ read-fcode-offset
+ ?negative IF
+ dest-on-top postpone again
+ ELSE
+ postpone else
+ get-ip next-ip fcode@ B2 = IF
+ drop
+ ELSE
+ set-ip
+ THEN
+ THEN
+ ELSE
+ read-fcode-offset ?jump-direction jump-n-ip
+ THEN
+; immediate
+
+: b(<mark) ( -- )
+ ?compile-mode IF postpone begin THEN
+ ; immediate
+
+: b(>resolve) ( -- )
+ ?compile-mode IF postpone then THEN
+ ; immediate
+
+: b(;)
+ <semicolon> compile, reveal
+ postpone [
+; immediate
+
+: b(:) ( -- )
+ <colon> compile, ]
+ ; immediate
+
+: b(case) ( sel -- sel )
+ postpone case
+ ; immediate
+
+: b(endcase)
+ postpone endcase
+ ; immediate
+
+: b(of)
+ postpone of
+ read-fcode-offset drop \ read and discard offset
+ ; immediate
+
+: b(endof)
+ postpone endof
+ read-fcode-offset drop
+ ; immediate
+
+: b(do)
+ postpone do
+ read-fcode-offset drop
+ ; immediate
+
+: b(?do)
+ postpone ?do
+ read-fcode-offset drop
+ ; immediate
+
+: b(loop)
+ postpone loop
+ read-fcode-offset drop
+ ; immediate
+
+: b(+loop)
+ postpone +loop
+ read-fcode-offset drop
+ ; immediate
+
+: b(leave)
+ postpone leave
+ ; immediate
+
+
+0 VALUE fc-instance?
+: fc-instance ( -- ) \ Mark next defining word as instance-specific.
+ TRUE TO fc-instance?
+;
+
+: new-token \ unnamed local fcode function
+ align here next-ip read-fcode# 0 swap set-token
+ ;
+
+: external-token ( -- ) \ named local fcode function
+ next-ip read-fcode-string
+ \ fc-instance? IF cr ." ext instance token: " 2dup type ." in " pwd cr THEN
+ header ( str len -- ) \ create a header in the current dictionary entry
+ new-token
+ ;
+
+: new-token
+ eva-debug? IF
+ s" x" get-ip >r next-ip read-fcode# r> set-ip (u.) $cat strdup
+ header
+ THEN
+ new-token
+;
+
+\ decide wether or not to give a new token an own name in the dictionary
+: named-token
+ fcode-debug? IF
+ external-token
+ ELSE
+ next-ip read-fcode-string 2drop \ Forget about the name
+ new-token
+ THEN
+;
+
+: b(to) ( val -- )
+ next-ip read-fcode#
+ get-token drop ( val xt )
+ dup @ ( val xt @xt )
+ dup <value> = over <defer> = OR IF
+ \ Destination is value or defer
+ drop
+ >body cell -
+ ( val addr )
+ ?compile-mode IF
+ literal, postpone !
+ ELSE
+ !
+ THEN
+ ELSE
+ <create> <> IF ( val xt )
+ TRUE ABORT" Invalid destination for FCODE b(to)"
+ THEN
+ dup cell+ @ ( val xt @xt+1cell )
+ dup <instancevalue> <> swap <instancedefer> <> AND IF
+ TRUE ABORT" Invalid destination for FCODE b(to)"
+ THEN
+ \ Destination is instance-value or instance-defer
+ >body @ ( val instance-offset )
+ ?compile-mode IF
+ literal, postpone >instance postpone !
+ ELSE
+ >instance !
+ THEN
+ ELSE
+ THEN
+; immediate
+
+: b(value)
+ fc-instance? IF
+ <create> , \ Needed for "(instance?)" for example
+ <instancevalue> ,
+ (create-instance-var)
+ FALSE TO fc-instance?
+ ELSE
+ <value> , ,
+ THEN
+ reveal
+;
+
+: b(variable)
+ fc-instance? IF
+ <create> , \ Needed for "(instance?)"
+ <instancevariable> ,
+ 0 (create-instance-var)
+ FALSE TO fc-instance?
+ ELSE
+ <variable> , 0 ,
+ THEN
+ reveal
+;
+
+: b(constant)
+ <constant> , , reveal
+ ;
+
+: undefined-defer
+ cr cr ." Uninitialized defer word has been executed!" cr cr
+ true fcode-end !
+ ;
+
+: b(defer)
+ fc-instance? IF
+ <create> , \ Needed for "(instance?)"
+ <instancedefer> ,
+ ['] undefined-defer (create-instance-var)
+ reveal
+ FALSE TO fc-instance?
+ ELSE
+ <defer> , reveal
+ postpone undefined-defer
+ THEN
+;
+
+: b(create)
+ <variable> ,
+ postpone noop reveal
+ ;
+
+: b(field) ( E: addr -- addr+offset ) ( F: offset size -- offset+size )
+ <colon> , over literal,
+ postpone +
+ <semicolon> compile,
+ reveal
+ +
+;
+
+: b(buffer:) ( E: -- a-addr) ( F: size -- )
+ fc-instance? IF
+ <create> , \ Needed for "(instance?)"
+ <instancebuffer> ,
+ (create-instance-buf)
+ FALSE TO fc-instance?
+ ELSE
+ <buffer:> , allot
+ THEN
+ reveal
+;
+
+: suspend-fcode ( -- )
+ noop \ has to be implemented more efficiently ;-)
+ ;
+
+: offset16 ( -- )
+ 2 to fcode-offset
+ ;
+
+: version1 ( -- )
+ 1 to fcode-spread
+ 1 to fcode-offset
+ read-header
+ ;
+
+: start0 ( -- )
+ 0 to fcode-spread
+ offset16
+ read-header
+ ;
+
+: start1 ( -- )
+ 1 to fcode-spread
+ offset16
+ read-header
+ ;
+
+: start2 ( -- )
+ 2 to fcode-spread
+ offset16
+ read-header
+ ;
+
+: start4 ( -- )
+ 4 to fcode-spread
+ offset16
+ read-header
+ ;
+
+: end0 ( -- )
+ true fcode-end !
+ ;
+
+: end1 ( -- )
+ end0
+ ;
+
+: ferror ( -- )
+ clear end0
+ cr ." FCode# " fcode-num @ . ." not assigned!"
+ cr ." FCode evaluation aborted." cr
+ ." ( -- S:" depth . ." R:" rdepth . ." ) " .s cr
+ abort
+ ;
+
+: reset-local-fcodes
+ FFF 800 DO ['] ferror 0 i set-token LOOP
+ ;
+
+: byte-load ( addr xt -- )
+ >r >r
+ save-evaluator-state
+ r> r>
+ reset-fcode-end
+ 1 to fcode-spread
+ dup 1 = IF drop ['] rb@ THEN to fcode-rb@
+ set-ip
+ reset-local-fcodes
+ depth >r
+ evaluate-fcode
+ r> depth 1- <> IF
+ clear end0
+ cr ." Ambiguous stack depth after byte-load!"
+ cr ." FCode evaluation aborted." cr cr
+ ELSE
+ restore-evaluator-state
+ THEN
+ ['] c@ to fcode-rb@
+;
+
+\ Functions for accessing memory ... since some FCODE programs use the normal
+\ memory access functions for accessing MMIO memory, too, we got to use a little
+\ hack to support them: When address is bigger than MIN-RAM-SIZE, assume the
+\ FCODE is trying to access MMIO memory and use the register based access
+\ functions instead!
+: fc-c@ ( addr -- byte ) dup MIN-RAM-SIZE > IF rb@ ELSE c@ THEN ;
+: fc-w@ ( addr -- word ) dup MIN-RAM-SIZE > IF rw@ ELSE w@ THEN ;
+: fc-<w@ ( addr -- word ) fc-w@ dup 8000 >= IF 10000 - THEN ;
+: fc-l@ ( addr -- long ) dup MIN-RAM-SIZE > IF rl@ ELSE l@ THEN ;
+: fc-<l@ ( addr -- long ) fc-l@ signed ;
+: fc-x@ ( addr -- dlong ) dup MIN-RAM-SIZE > IF rx@ ELSE x@ THEN ;
+: fc-c! ( byte addr -- ) dup MIN-RAM-SIZE > IF rb! ELSE c! THEN ;
+: fc-w! ( word addr -- ) dup MIN-RAM-SIZE > IF rw! ELSE w! THEN ;
+: fc-l! ( long addr -- ) dup MIN-RAM-SIZE > IF rl! ELSE l! THEN ;
+: fc-x! ( dlong addr -- ) dup MIN-RAM-SIZE > IF rx! ELSE x! THEN ;
+
+: fc-fill ( add len byte -- ) 2 pick MIN-RAM-SIZE > IF rfill ELSE fill THEN ;
+: fc-move ( src dst len -- )
+ 2 pick MIN-RAM-SIZE > \ Check src
+ 2 pick MIN-RAM-SIZE > \ Check dst
+ OR IF rmove ELSE move THEN
+;
+
+\ Destroy virtual mapping (should maybe also update "address" property here?)
+: free-virtual ( virt size -- )
+ s" map-out" $call-parent
+;
+
+\ Map the specified region, return virtual address
+: map-low ( phys.lo ... size -- virt )
+ my-space swap s" map-in" $call-parent
+;
+
+\ Get MAC address
+: mac-address ( -- mac-str mac-len )
+ s" local-mac-address" get-my-property IF
+ 0 0
+ THEN
+;
+
+\ Output line and column number - not used yet
+VARIABLE #line
+0 #line !
+VARIABLE #out
+0 #out !
+
+\ Display device status
+: display-status ( n -- )
+ ." Device status: " . cr
+;
+
+\ Obsolete variables:
+VARIABLE group-code
+0 group-code !
+
+\ Obsolete: Allocate memory for DMA
+: dma-alloc ( byte -- virtual )
+ s" dma-alloc" $call-parent
+;
+
+\ Obsolete: Get params property
+: my-params ( -- addr len )
+ s" params" get-my-property IF
+ 0 0
+ THEN
+;
+
+\ Obsolete: Convert SBus interrupt level to CPU interrupt level
+: sbus-intr>cpu ( sbus-intr# -- cpu-intr# )
+;
+
+\ Obsolete: Set "intr" property
+: intr ( interrupt# vector -- )
+ >r sbus-intr>cpu encode-int r> encode-int+ s" intr" property
+;
+
+\ Obsolete: Create the "name" property
+: driver ( addr len -- )
+ encode-string s" name" property
+;
+
+\ Obsolete: Return type of CPU
+: processor-type ( -- cpu-type )
+ 0
+;
+
+\ Obsolete: Return firmware version
+: firmware-version ( -- n )
+ 10000 \ Just a dummy value
+;
+
+\ Obsolete: Return fcode-version
+: fcode-version ( -- n )
+ fcode-revision
+;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/core.fs b/qemu/roms/SLOF/slof/fs/fcode/core.fs
new file mode 100644
index 000000000..8fd98ec19
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/core.fs
@@ -0,0 +1,173 @@
+\ *****************************************************************************
+\ * 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
+;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs b/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs
new file mode 100644
index 000000000..8f0bae527
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/evaluator.fs
@@ -0,0 +1,119 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 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
+\ ****************************************************************************/
+
+
+variable ip
+variable fcode-end
+variable fcode-num
+ 1 value fcode-spread
+ 2 value fcode-offset
+false value eva-debug?
+true value fcode-debug?
+defer fcode-rb@
+defer fcode@
+
+' c@ to fcode-rb@
+
+create token-table 2000 cells allot \ 1000h = 4096d
+
+#include "core.fs"
+#include "1275.fs"
+#include "tokens.fs"
+#include "locals.fs"
+
+0 value buff
+0 value buff-size
+
+' read-fcode# to fcode@
+
+( ---------------------------------------------------- )
+
+: execute-rom-fcode ( addr len | false -- )
+ reset-fcode-end
+ ?dup IF
+ diagnostic-mode? IF ." , executing ..." cr THEN
+ dup >r r@ alloc-mem dup >r swap rmove
+ r@ set-ip evaluate-fcode
+ diagnostic-mode? IF ." Done." cr THEN
+ r> r> free-mem
+ THEN
+;
+
+: rom-code-ignored ( image-addr name len -- image-addr )
+ diagnostic-mode? IF
+ type ." code found in image " dup . ." , ignoring ..." cr
+ ELSE
+ 2drop
+ THEN
+;
+
+: pci-find-rom ( baseaddr -- addr )
+ dup IF
+ dup rw@-le aa55 = IF
+ diagnostic-mode? IF ." Device ROM header found at " dup . cr THEN
+ ELSE
+ drop 0
+ THEN
+ THEN
+;
+
+: pci-find-fcode ( baseaddr -- addr len | false )
+ BEGIN
+ 1ff NOT and \ Image must start at 512 byte boundary
+ pci-find-rom dup
+ WHILE
+ dup 18 + rw@-le + ( pcir-addr )
+ \ Check for PCIR magic ... since pcir-addr might not be
+ \ 4-byte aligned, we've got to use two reads here:
+ dup rw@-le 4350 ( 'PC' ) <> ( pcir-addr hasPC? )
+ over 2+ rw@-le 5249 ( 'IR' ) <> OR IF
+ diagnostic-mode? IF
+ ." Invalid PCI Data structure, ignoring ROM contents" cr
+ THEN
+ drop false EXIT
+ THEN ( pcir-addr )
+ dup 14 + rb@ CASE \ Get image code type
+ 0 OF s" Intel x86 BIOS" rom-code-ignored ENDOF
+ 1 OF
+ diagnostic-mode? IF
+ ." Open Firmware FCode found in image at " dup . cr
+ THEN
+ dup 1ff NOT AND \ Back to the ROM image header
+ dup 2+ rw@-le + \ Pointer to FCODE (PCI bus binding ch.9)
+ swap 10 + rw@-le 200 * \ Image length
+ EXIT
+ ENDOF
+ 2 OF s" HP PA RISC" rom-code-ignored ENDOF
+ 3 OF s" EFI" rom-code-ignored ENDOF
+ dup OF s" Unknown type" rom-code-ignored ENDOF
+ ENDCASE
+ dup 15 + rb@ 80 and IF \ End of last image?
+ drop false EXIT
+ THEN
+ dup 10 + rw@-le 200 * + \ Next image start
+ REPEAT
+;
+
+
+\ Prepare and run a FCODE program from a PCI Option ROM.
+: pci-execute-fcode ( baseaddr -- )
+ pci-find-fcode dup 0= IF
+ 2drop EXIT
+ THEN ( addr len )
+ fc-set-pci-mmio-tokens \ Prepare PCI access functions
+ \ Now run the FCODE:
+ ['] execute-rom-fcode CATCH IF
+ cr ." FCODE failed!" cr
+ 2drop
+ THEN
+ fc-set-normal-mmio-tokens \ Restore normal MMIO access functions
+;
diff --git a/qemu/roms/SLOF/slof/fs/fcode/little-big.fs b/qemu/roms/SLOF/slof/fs/fcode/little-big.fs
new file mode 100644
index 000000000..309c626a9
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/little-big.fs
@@ -0,0 +1,96 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 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
+\ ****************************************************************************/
+
+\ little- and big-endian FCODE IP access functions
+
+
+?bigendian [IF] \ Big endian access functions first
+
+
+: read-fcode-num16 ( -- n )
+ 0 fcode-num !
+ ?arch64 IF
+ read-byte fcode-num 6 + C!
+ next-ip
+ read-byte fcode-num 7 + C!
+ ELSE
+ read-byte fcode-num 2 + C!
+ next-ip
+ read-byte fcode-num 3 + C!
+ THEN
+ fcode-num @
+;
+
+: read-fcode-num32 ( -- n )
+ 0 fcode-num !
+ ?arch64 IF
+ read-byte fcode-num 4 + C!
+ next-ip
+ read-byte fcode-num 5 + C!
+ next-ip
+ read-byte fcode-num 6 + C!
+ next-ip
+ read-byte fcode-num 7 + C!
+ ELSE
+ read-byte fcode-num 0 + C!
+ next-ip
+ read-byte fcode-num 1 + C!
+ next-ip
+ read-byte fcode-num 2 + C!
+ next-ip
+ read-byte fcode-num 3 + C!
+ THEN
+ fcode-num @
+;
+
+
+[ELSE] \ Now the little endian access functions
+
+
+: read-fcode-num16 ( -- n )
+ 0 fcode-num !
+ ?arch64 IF
+ read-byte fcode-num 7 + C!
+ next-ip
+ read-byte fcode-num 6 + C!
+ ELSE
+ read-byte fcode-num 1 + C!
+ next-ip
+ read-byte fcode-num 0 + C!
+ THEN
+ fcode-num @
+;
+
+: read-fcode-num32 ( adr -- n )
+ 0 fcode-num !
+ ?arch64 IF
+ read-byte fcode-num 7 + C!
+ next-ip
+ read-byte fcode-num 6 + C!
+ next-ip
+ read-byte fcode-num 5 + C!
+ next-ip
+ read-byte fcode-num 4 + C!
+ ELSE
+ read-byte fcode-num 3 + C!
+ next-ip
+ read-byte fcode-num 2 + C!
+ next-ip
+ read-byte fcode-num 1 + C!
+ next-ip
+ read-byte fcode-num 0 + C!
+ THEN
+ fcode-num @
+;
+
+
+[THEN]
diff --git a/qemu/roms/SLOF/slof/fs/fcode/locals.fs b/qemu/roms/SLOF/slof/fs/fcode/locals.fs
new file mode 100644
index 000000000..5381df058
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/locals.fs
@@ -0,0 +1,155 @@
+\ *****************************************************************************
+\ * Copyright (c) 2011 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
+\ ****************************************************************************/
+\ *
+\ * Support for old-fashioned local values in FCODE.
+\ *
+\ * There is one old FCODE tokenizer that uses the FCODE opcodes in the range
+\ * of 0x407 to 0x41f for supporting Forth local values. Each locals stack
+\ * frame contains 8 variables. The opcodes from 0x407 to 0x40f are used to
+\ * push 0 up to 8 values from the normal data stack into the current locals
+\ * stack frame. All other variables in the current stack frame are not
+\ * pre-initialized.
+\ * The opcodes from 0x410 to 0x417 can be used for reading the first, second,
+\ * ... eighth value out of the locals stack frame, and the opcode from 0x418
+\ * to 0x41f can be used to set the first, second, ... eighth value in the
+\ * stack frame respectively.
+\ *
+
+80 cells CONSTANT LOCALS-STACK-SIZE
+
+LOCALS-STACK-SIZE BUFFER: localsstackbuf
+
+localsstackbuf VALUE localsstack
+
+
+: fc-local@ ( n -- val )
+ cells localsstack swap - @
+;
+
+: fc-local-1-@ 1 fc-local@ ;
+: fc-local-2-@ 2 fc-local@ ;
+: fc-local-3-@ 3 fc-local@ ;
+: fc-local-4-@ 4 fc-local@ ;
+: fc-local-5-@ 5 fc-local@ ;
+: fc-local-6-@ 6 fc-local@ ;
+: fc-local-7-@ 7 fc-local@ ;
+: fc-local-8-@ 8 fc-local@ ;
+
+
+: fc-local! ( val n -- )
+ cells localsstack swap - !
+;
+
+: fc-local-1-! 1 fc-local! ;
+: fc-local-2-! 2 fc-local! ;
+: fc-local-3-! 3 fc-local! ;
+: fc-local-4-! 4 fc-local! ;
+: fc-local-5-! 5 fc-local! ;
+: fc-local-6-! 6 fc-local! ;
+: fc-local-7-! 7 fc-local! ;
+: fc-local-8-! 8 fc-local! ;
+
+
+0 VALUE uses-locals?
+
+\ Create space for the current function on the locals stack.
+\ Pre-initialized the n first locals with the n top-most data stack items.
+\ Note: Each function can use up to 8 (initialized or uninitialized) locals.
+: (fc-push-locals) ( ... n -- )
+ \ cr ." pushing " dup . ." locals" cr
+ 8 cells localsstack + TO localsstack
+ localsstack localsstackbuf -
+ LOCALS-STACK-SIZE > ABORT" Locals stack exceeded!"
+ ?dup IF
+ ( ... n ) 1 swap DO
+ i fc-local! \ Store pre-initialized locals
+ -1 +LOOP
+ THEN
+;
+
+: fc-push-locals ( n -- )
+ \ cr ." compiling push for " dup . ." locals" cr
+ uses-locals? ABORT" Definition pushes locals multiple times!"
+ true TO uses-locals?
+ ( n ) ['] literal execute
+ ['] (fc-push-locals) compile,
+;
+
+: fc-push-0-locals 0 fc-push-locals ;
+: fc-push-1-locals 1 fc-push-locals ;
+: fc-push-2-locals 2 fc-push-locals ;
+: fc-push-3-locals 3 fc-push-locals ;
+: fc-push-4-locals 4 fc-push-locals ;
+: fc-push-5-locals 5 fc-push-locals ;
+: fc-push-6-locals 6 fc-push-locals ;
+: fc-push-7-locals 7 fc-push-locals ;
+: fc-push-8-locals 8 fc-push-locals ;
+
+
+: fc-pop-locals ( -- )
+ \ ." popping locals" cr
+ localsstack 8 cells - TO localsstack
+ localsstack localsstackbuf - 0 < ABORT" Locals stack undeflow!"
+;
+
+
+: fc-locals-exit
+ uses-locals? IF
+ \ ." compiling pop-locals for exit" cr
+ ['] fc-pop-locals compile,
+ THEN
+ ['] exit compile,
+;
+
+: fc-locals-b(;)
+ uses-locals? IF
+ \ ." compiling pop-locals for b(;)" cr
+ ['] fc-pop-locals compile,
+ THEN
+ false TO uses-locals?
+ ['] b(;) execute
+;
+
+
+: fc-set-locals-tokens ( -- )
+ ['] fc-push-0-locals 1 407 set-token
+ ['] fc-push-1-locals 1 408 set-token
+ ['] fc-push-2-locals 1 409 set-token
+ ['] fc-push-3-locals 1 40a set-token
+ ['] fc-push-4-locals 1 40b set-token
+ ['] fc-push-5-locals 1 40c set-token
+ ['] fc-push-6-locals 1 40d set-token
+ ['] fc-push-7-locals 1 40e set-token
+ ['] fc-push-8-locals 1 40f set-token
+
+ ['] fc-local-1-@ 0 410 set-token
+ ['] fc-local-2-@ 0 411 set-token
+ ['] fc-local-3-@ 0 412 set-token
+ ['] fc-local-4-@ 0 413 set-token
+ ['] fc-local-5-@ 0 414 set-token
+ ['] fc-local-6-@ 0 415 set-token
+ ['] fc-local-7-@ 0 416 set-token
+ ['] fc-local-8-@ 0 417 set-token
+
+ ['] fc-local-1-! 0 418 set-token
+ ['] fc-local-2-! 0 419 set-token
+ ['] fc-local-3-! 0 41a set-token
+ ['] fc-local-4-! 0 41b set-token
+ ['] fc-local-5-! 0 41c set-token
+ ['] fc-local-6-! 0 41d set-token
+ ['] fc-local-7-! 0 41e set-token
+ ['] fc-local-8-! 0 41f set-token
+
+ ['] fc-locals-exit 1 33 set-token
+ ['] fc-locals-b(;) 1 c2 set-token
+;
+fc-set-locals-tokens
diff --git a/qemu/roms/SLOF/slof/fs/fcode/tokens.fs b/qemu/roms/SLOF/slof/fs/fcode/tokens.fs
new file mode 100644
index 000000000..3efc17e06
--- /dev/null
+++ b/qemu/roms/SLOF/slof/fs/fcode/tokens.fs
@@ -0,0 +1,480 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2011 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
+\ ****************************************************************************/
+
+: fc-abort ." FCode called abort: IP " get-ip . ( ." STACK: " .s ) depth dup 0< IF abort THEN . rdepth . cr abort ;
+: fc-0 ." 0(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 0 ;
+: fc-1 ." 1(lit): STACK ( S: " depth . ." R: " rdepth . ." ): " depth 0> IF .s THEN 1 ;
+
+: parse-1hex 1 hex-decode-unit ;
+
+\ Adjust functions for accessing MMIO registers. According to IEEE 1275,
+\ a bus device can substitute bus-specific implementations of r*@ and r*!
+\ for use by its children, e.g. with respect to byte-order. Since PCI is
+\ little endian by default, we've got to use the little endian accessor
+\ functions for the PCI bus (some FCODE programs are expecting this behavior).
+: fc-set-pci-mmio-tokens ( -- )
+ ['] rw@-le 0 232 set-token
+ ['] rw!-le 0 233 set-token
+ ['] rl@-le 0 234 set-token
+ ['] rl!-le 0 235 set-token
+ ['] rx@-le 0 22E set-token
+ ['] rx!-le 0 22F set-token
+;
+
+\ Set normal MMIO access token behavior:
+: fc-set-normal-mmio-tokens ( -- )
+ ['] rw@ 0 232 set-token
+ ['] rw! 0 233 set-token
+ ['] rl@ 0 234 set-token
+ ['] rl! 0 235 set-token
+ ['] rx@ 0 22E set-token
+ ['] rx! 0 22F set-token
+;
+
+: reset-token-table
+ FFF 0 DO ['] ferror 0 i set-token LOOP
+ ;
+
+reset-token-table
+
+' end0 0 00 set-token
+
+\ 01...0F beginning code of 2-byte FCode sequences
+
+' b(lit) 1 10 set-token
+
+' b(') 1 11 set-token
+' b(") 1 12 set-token
+' bbranch 1 13 set-token
+' b?branch 1 14 set-token
+' b(loop) 1 15 set-token
+' b(+loop) 1 16 set-token
+' b(do) 1 17 set-token
+' b(?do) 1 18 set-token
+' i 0 19 set-token
+' j 0 1A set-token
+' b(leave) 1 1B set-token
+' b(of) 1 1C set-token
+' execute 0 1D set-token
+' + 0 1E set-token
+' - 0 1F set-token
+' * 0 20 set-token
+' / 0 21 set-token
+' mod 0 22 set-token
+' and 0 23 set-token
+' or 0 24 set-token
+' xor 0 25 set-token
+' invert 0 26 set-token
+' lshift 0 27 set-token
+' rshift 0 28 set-token
+' >>a 0 29 set-token
+' /mod 0 2A set-token
+' u/mod 0 2B set-token
+' negate 0 2C set-token
+' abs 0 2D set-token
+' min 0 2E set-token
+' max 0 2F set-token
+' >r 0 30 set-token
+' r> 0 31 set-token
+' r@ 0 32 set-token
+' exit 0 33 set-token
+' 0= 0 34 set-token
+' 0<> 0 35 set-token
+' 0< 0 36 set-token
+' 0<= 0 37 set-token
+' 0> 0 38 set-token
+' 0>= 0 39 set-token
+' < 0 3A set-token
+' > 0 3B set-token
+' = 0 3C set-token
+' <> 0 3D set-token
+' u> 0 3E set-token
+' u<= 0 3F set-token
+' u< 0 40 set-token
+' u>= 0 41 set-token
+' >= 0 42 set-token
+' <= 0 43 set-token
+' between 0 44 set-token
+' within 0 45 set-token
+' DROP 0 46 set-token
+' DUP 0 47 set-token
+' OVER 0 48 set-token
+' SWAP 0 49 set-token
+' ROT 0 4A set-token
+' -ROT 0 4B set-token
+' TUCK 0 4C set-token
+' nip 0 4D set-token
+' pick 0 4E set-token
+' roll 0 4F set-token
+' ?dup 0 50 set-token
+' depth 0 51 set-token
+' 2drop 0 52 set-token
+' 2dup 0 53 set-token
+' 2over 0 54 set-token
+' 2swap 0 55 set-token
+' 2rot 0 56 set-token
+' 2/ 0 57 set-token
+' u2/ 0 58 set-token
+' 2* 0 59 set-token
+' /c 0 5A set-token
+' /w 0 5B set-token
+' /l 0 5C set-token
+' /n 0 5D set-token
+' ca+ 0 5E set-token
+' wa+ 0 5F set-token
+' la+ 0 60 set-token
+' na+ 0 61 set-token
+' char+ 0 62 set-token
+' wa1+ 0 63 set-token
+' la1+ 0 64 set-token
+' cell+ 0 65 set-token
+' chars 0 66 set-token
+' /w* 0 67 set-token
+' /l* 0 68 set-token
+' cells 0 69 set-token
+' on 0 6A set-token
+' off 0 6B set-token
+' +! 0 6C set-token
+' @ 0 6D set-token
+' fc-l@ 0 6E set-token
+' fc-w@ 0 6F set-token
+' fc-<w@ 0 70 set-token
+' fc-c@ 0 71 set-token
+' ! 0 72 set-token
+' fc-l! 0 73 set-token
+' fc-w! 0 74 set-token
+' fc-c! 0 75 set-token
+' 2@ 0 76 set-token
+' 2! 0 77 set-token
+' fc-move 0 78 set-token
+' fc-fill 0 79 set-token
+' comp 0 7A set-token
+' noop 0 7B set-token
+' lwsplit 0 7C set-token
+' wljoin 0 7D set-token
+' lbsplit 0 7E set-token
+' bljoin 0 7F set-token
+' wbflip 0 80 set-token
+' upc 0 81 set-token
+' lcc 0 82 set-token
+' pack 0 83 set-token
+' count 0 84 set-token
+' body> 0 85 set-token
+' >body 0 86 set-token
+' fcode-revision 0 87 set-token
+' span 0 88 set-token
+' unloop 0 89 set-token
+' expect 0 8A set-token
+' alloc-mem 0 8B set-token
+' free-mem 0 8C set-token
+' key? 0 8D set-token
+' key 0 8E set-token
+' emit 0 8F set-token
+' type 0 90 set-token
+' (cr 0 91 set-token
+' cr 0 92 set-token
+' #out 0 93 set-token
+' #line 0 94 set-token
+' hold 0 95 set-token
+' <# 0 96 set-token
+' u#> 0 97 set-token
+' sign 0 98 set-token
+' u# 0 99 set-token
+' u#s 0 9A set-token
+' u. 0 9B set-token
+' u.r 0 9C set-token
+' . 0 9D set-token
+' .r 0 9E set-token
+' .s 0 9F set-token
+' base 0 A0 set-token
+\ ' convert 0 A1 set-token \ historical, not supported
+' $number 0 A2 set-token
+' digit 0 A3 set-token
+' -1 0 A4 set-token
+' 0 0 A5 set-token
+' 1 0 A6 set-token
+' 2 0 A7 set-token
+' 3 0 A8 set-token
+' bl 0 A9 set-token
+' bs 0 AA set-token
+' bell 0 AB set-token
+' bounds 0 AC set-token
+' here 0 AD set-token
+' aligned 0 AE set-token
+' wbsplit 0 AF set-token
+' bwjoin 0 B0 set-token
+' b(<mark) 1 B1 set-token
+' b(>resolve) 1 B2 set-token
+\ ' set-token-table 0 B3 set-token \ historical, not supported
+\ ' set-table 0 B4 set-token \ historical, not supported
+' new-token 0 B5 set-token
+' named-token 0 B6 set-token
+' b(:) 1 B7 set-token
+' b(value) 1 B8 set-token
+' b(variable) 1 B9 set-token
+' b(constant) 1 BA set-token
+' b(create) 1 BB set-token
+' b(defer) 1 BC set-token
+' b(buffer:) 1 BD set-token
+' b(field) 1 BE set-token
+\ ' b(code) 0 BF set-token \ historical, not supported
+' fc-instance 1 C0 set-token
+\ ' ferror 0 C1 set-token \ Reserved
+' b(;) 1 C2 set-token
+' b(to) 1 C3 set-token
+' b(case) 1 C4 set-token
+' b(endcase) 1 C5 set-token
+' b(endof) 1 C6 set-token
+' # 0 C7 set-token
+' #s 0 C8 set-token
+' #> 0 C9 set-token
+' external-token 0 CA set-token
+' $find 0 CB set-token
+' offset16 0 CC set-token
+' evaluate 0 CD set-token
+\ 0 CE reserved
+\ 0 CF reserved
+' c, 0 D0 set-token
+' w, 0 D1 set-token
+' l, 0 D2 set-token
+' , 0 D3 set-token
+' um* 0 D4 set-token
+' um/mod 0 D5 set-token
+\ 0 D6 reserved
+\ 0 D7 reserved
+' d+ 0 D8 set-token
+' d- 0 D9 set-token
+' get-token 0 DA set-token
+' set-token 0 DB set-token
+' state 0 DC set-token \ possibly broken
+' compile, 0 DD set-token
+' behavior 0 DE set-token
+
+\ Tokens 0xDF to 0xEF are reserved
+
+' start0 0 F0 set-token
+' start1 0 F1 set-token
+' start2 0 F2 set-token
+' start4 0 F3 set-token
+
+\ Tokens 0xF4 to 0xFB are reserved
+
+' ferror 0 FC set-token
+' version1 0 FD set-token
+
+\ ' 4-byte-id 0 FE set-token \ Historical, not supported
+' end1 0 FF set-token
+
+\ 0 100 set-token \ reserved
+' dma-alloc 0 101 set-token \ Obsolete
+' my-address 0 102 set-token
+' my-space 0 103 set-token
+\ ' memmap 0 104 set-token \ Obsolete
+' free-virtual 0 105 set-token
+\ ' >physical 0 106 set-token \ Obsolete
+
+\ Tokens 0x107 to 0x10e are reserved
+
+' my-params 0 10f set-token \ Obsolete
+' property 0 110 set-token
+' encode-int 0 111 set-token
+' encode+ 0 112 set-token
+' encode-phys 0 113 set-token
+' encode-string 0 114 set-token
+' encode-bytes 0 115 set-token
+' reg 0 116 set-token
+' intr 0 117 set-token \ Obsolete
+' driver 0 118 set-token \ Obsolete
+' model 0 119 set-token
+' device-type 0 11A set-token
+' parse-2int 0 11B set-token
+\ ' is-install 0 11C set-token \ Will be set by framebuffer code
+\ ' is-remove 0 11D set-token \ Will be set by framebuffer code
+\ ' is-selftest 0 11E set-token \ Will be set by framebuffer code
+' new-device 0 11F set-token
+' diagnostic-mode? 0 120 set-token
+' display-status 0 121 set-token \ Maybe obsolete
+' memory-test-suite 0 122 set-token
+' group-code 0 123 set-token \ Obsolete
+' mask 0 124 set-token
+' get-msecs 0 125 set-token
+' ms 0 126 set-token
+' finish-device 0 127 set-token
+' decode-phys 0 128 set-token
+\ ' push-package 0 129 set-token \ TODO - from proposal 215
+\ ' pop-package 0 12A set-token \ TODO - from proposal 215
+' interpose 0 12B set-token \ Recommended practice: Interposition
+
+\ Tokens 0x12C to 0x12F are reserved
+
+' map-low 0 130 set-token
+' sbus-intr>cpu 0 131 set-token \ Obsolete
+
+\ Tokens 0x132 to 0x14f are reserved
+
+\ The following tokens will be set by the framebuffer code:
+\ ' #lines 0 150 set-token
+\ ' #columns 0 151 set-token
+\ ' line# 0 152 set-token
+\ ' column# 0 153 set-token
+\ ' inverse? 0 154 set-token
+\ ' inverse-screen? 0 155 set-token
+\ ' frame-buffer-busy 0 156 set-token \ Historical, not supported
+\ ' draw-character 0 157 set-token
+\ ' reset-screen 0 158 set-token
+\ ' toggle-cursor 0 159 set-token
+\ ' erase-screen 0 15A set-token
+\ ' blink-screen 0 15B set-token
+\ ' invert-screen 0 15C set-token
+\ ' insert-characters 0 15D set-token
+\ ' delete-characters 0 15E set-token
+\ ' insert-lines 0 15F set-token
+\ ' delete-lines 0 160 set-token
+\ ' draw-logo 0 161 set-token
+\ ' frame-buffer-adr 0 162 set-token
+\ ' screen-height 0 163 set-token
+\ ' screen-width 0 164 set-token
+\ ' window-top 0 165 set-token
+\ ' window-left 0 166 set-token
+\ ' 0 167 set-token \ Reserved
+\ ' foreground-color 0 168 set-token \ From 16-color recommended practice
+\ ' background-color 0 169 set-token \ From 16-color recommended practice
+\ ' default-font 0 16A set-token
+\ ' set-font 0 16B set-token
+\ ' char-height 0 16C set-token
+\ ' char-width 0 16D set-token
+\ ' >font 0 16E set-token
+\ ' fontbytes 0 16F set-token
+
+\ Tokens 0x170 to 0x17C are obsolete fb1 functions
+\ Tokens 0x17D to 0x17F are reserved
+
+\ The following tokens will be set by the framebuffer code, too:
+\ ' fb8-draw-character 0 180 set-token
+\ ' fb8-reset-screen 0 181 set-token
+\ ' fb8-toggle-cursor 0 182 set-token
+\ ' fb8-erase-screen 0 183 set-token
+\ ' fb8-blink-screen 0 184 set-token
+\ ' fb8-invert-screen 0 185 set-token
+\ ' fb8-insert-characters 0 186 set-token
+\ ' fb8-delete-characters 0 187 set-token
+\ ' fb8-insert-lines 0 188 set-token
+\ ' fb8-delete-lines 0 189 set-token
+\ ' fb8-draw-logo 0 18A set-token
+\ ' fb8-install 0 18B set-token
+
+\ Tokens 0x18C to 0x18F are reserved
+\ Tokens 0x190 to 0x196 are obsolete VMEbus tokens
+\ Tokens 0x197 to 0x19F are reserved
+
+\ ' return-buffer 0 1A0 set-token \ Historical, not supported
+\ ' xmit-packet 0 1A1 set-token \ Historical, not supported
+\ ' poll-packet 0 1A2 set-token \ Historical, not supported
+\ 0 1A3 set-token \ reserved
+' mac-address 0 1A4 set-token
+
+\ Tokens 0x1A5 to 0x200 are reserved
+
+' device-name 0 201 set-token
+' my-args 0 202 set-token
+' my-self 0 203 set-token
+' find-package 0 204 set-token
+' open-package 0 205 set-token
+' close-package 0 206 set-token
+' find-method 0 207 set-token
+' call-package 0 208 set-token
+' $call-parent 0 209 set-token
+' my-parent 0 20A set-token
+' ihandle>phandle 0 20B set-token
+\ 0 20C set-token \ reserved
+' my-unit 0 20D set-token
+' $call-method 0 20E set-token
+' $open-package 0 20F set-token
+' processor-type 0 210 set-token \ Obsolete
+' firmware-version 0 211 set-token \ Obsolete
+' fcode-version 0 212 set-token \ Obsolete
+\ ' alarm 0 213 set-token \ TODO
+' (is-user-word) 0 214 set-token
+' suspend-fcode 0 215 set-token
+' fc-abort 0 216 set-token
+' catch 0 217 set-token
+' throw 0 218 set-token
+\ ' user-abort 0 219 set-token \ TODO
+' get-my-property 0 21A set-token
+' decode-int 0 21B set-token
+' decode-string 0 21C set-token
+' get-inherited-property 0 21D set-token
+' delete-property 0 21E set-token
+' get-package-property 0 21F set-token
+' cpeek 0 220 set-token
+' wpeek 0 221 set-token
+' lpeek 0 222 set-token
+' cpoke 0 223 set-token
+' wpoke 0 224 set-token
+' lpoke 0 225 set-token
+' lwflip 0 226 set-token
+' lbflip 0 227 set-token
+' lbflips 0 228 set-token
+\ ' adr-mask 0 229 set-token \ Historical, not supported
+
+\ Tokens 0x22A to 0x22F are reserved
+
+' rb@ 0 230 set-token
+' rb! 0 231 set-token
+fc-set-normal-mmio-tokens \ Set rw@, rw!, rl@, rl!, rx@ and rx!
+
+' wbflips 0 236 set-token
+' lwflips 0 237 set-token
+\ ' probe 0 238 set-token \ Obsolete
+\ ' probe-virtual 0 239 set-token \ Obsolete
+\ 0 23A reserved
+' child 0 23B set-token
+' peer 0 23C set-token
+' next-property 0 23D set-token
+' byte-load 0 23E set-token
+' set-args 0 23F set-token
+' left-parse-string 0 240 set-token
+
+\ 64-bit extension tokens:
+' bxjoin 0 241 set-token
+' fc-<l@ 0 242 set-token
+' lxjoin 0 243 set-token
+' wxjoin 0 244 set-token
+' x, 0 245 set-token
+' fc-x@ 0 246 set-token
+' fc-x! 0 247 set-token
+' /x 0 248 set-token
+' /x* 0 249 set-token
+' xa+ 0 24A set-token
+' xa1+ 0 24B set-token
+' xbflip 0 24C set-token
+' xbflips 0 24D set-token
+' xbsplit 0 24E set-token
+' xlflip 0 24F set-token
+' xlflips 0 250 set-token
+' xlsplit 0 251 set-token
+' xwflip 0 252 set-token
+' xwflips 0 253 set-token
+' xwsplit 0 254 set-token
+
+\ 0 255 RESERVED FCODES
+\ ...
+\ 0 5FF RESERVED FCODES
+
+\ 0 600 VENDOR FCODES
+\ ...
+\ 0 7FF VENDOR FCODES
+
+\ 0 800 LOCAL FCODES
+\ ...
+\ 0 FFF LOCAL FCODES
+