aboutsummaryrefslogtreecommitdiff
path: root/slof/fs/fcode
diff options
context:
space:
mode:
Diffstat (limited to 'slof/fs/fcode')
-rw-r--r--slof/fs/fcode/1275.fs353
-rw-r--r--slof/fs/fcode/big.fs45
-rw-r--r--slof/fs/fcode/core.fs169
-rw-r--r--slof/fs/fcode/evaluator.fs99
-rw-r--r--slof/fs/fcode/tokens.fs411
5 files changed, 1077 insertions, 0 deletions
diff --git a/slof/fs/fcode/1275.fs b/slof/fs/fcode/1275.fs
new file mode 100644
index 0000000..39ee3ed
--- /dev/null
+++ b/slof/fs/fcode/1275.fs
@@ -0,0 +1,353 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2007 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
+\ ****************************************************************************/
+
+0 value function-type ' function-type @ constant <value>
+ variable function-type ' function-type @ constant <variable>
+0 constant function-type ' function-type @ constant <constant>
+: function-type ; ' function-type @ constant <colon>
+create function-type ' function-type @ constant <create>
+defer function-type ' function-type @ constant <defer>
+
+\ variable tmp-buf-current
+\ variable orig-here
+\ create tmp-buf 10000 allot
+
+( ---------------------------------------------------- )
+
+: 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 FFFF swap - negate 2- THEN
+ ;
+
+: ?negative
+ 8000 and
+ ;
+
+: dest-on-top
+ 0 >r BEGIN dup @ 0= WHILE >r REPEAT
+ BEGIN r> dup WHILE swap REPEAT
+ drop
+ ;
+
+: ?branch
+ true =
+ ;
+
+: read-fcode-offset \ ELSE needs to be fixed!
+ ?offset16 IF next-ip read-fcode-num16 ELSE THEN
+ ;
+
+: b?branch ( flag -- )
+ ?compile-mode IF
+ read-fcode-offset ?negative IF dest-on-top postpone until
+ ELSE postpone if
+ THEN
+ ELSE
+ ?branch IF 2 jump-n-ip
+ ELSE read-fcode-offset
+ ?jump-direction 2- 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 2- jump-n-ip
+ THEN
+ ; immediate
+
+: b(<mark) ( -- )
+ ?compile-mode IF postpone begin THEN
+ ; immediate
+
+: b(>resolve) ( -- )
+ ?compile-mode IF postpone then THEN
+ ; immediate
+
+: ffwto; ( -- )
+ BEGIN fcode@ dup c2 <> WHILE
+." ffwto: skipping " dup . ." @ " get-ip . cr
+ CASE 10 OF ( lit ) read-fcode-num32 drop ENDOF
+ 11 OF ( ' ) read-fcode# drop ENDOF
+ 12 OF ( " ) read-fcode-string 2drop ENDOF
+ 13 OF ( bbranch ) read-fcode-offset drop ENDOF
+ 14 OF ( b?branch ) read-fcode-offset drop ENDOF
+ 15 OF ( loop ) read-fcode-offset drop ENDOF
+ 16 OF ( +loop ) read-fcode-offset drop ENDOF
+ 17 OF ( do ) read-fcode-offset drop ENDOF
+ 18 OF ( ?do ) read-fcode-offset drop ENDOF
+ 1C OF ( of ) read-fcode-offset drop ENDOF
+ C6 OF ( endof ) read-fcode-offset drop ENDOF
+ C3 OF ( to ) read-fcode# drop ENDOF
+ dup OF next-ip ENDOF
+ ENDCASE
+ REPEAT next-ip
+;
+
+: rpush ( rparm -- ) \ push the rparm to be on top of return stack after exit
+ r> swap >r >r
+;
+
+: rpop ( -- rparm ) \ pop the rparm that was on top of return stack before this
+ r> r> swap >r
+;
+
+: b1(;) ( -- )
+." b1(;)" cr
+ rpop set-ip
+;
+
+\ : b1(:) ( -- )
+\ ." b1(:)" cr
+\ <colon> compile, get-ip 1+ literal ] get-ip rpush set-ip [
+\ ffwto;
+\ ; immediate
+
+: b(;) ( -- )
+ postpone exit 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
+
+: 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
+ 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
+;
+
+: named-token \ decide wether or not to give a new token an own name in the dictionary
+ fcode-debug? IF new-token ELSE external-token THEN
+ ;
+
+: b(to) ( x -- )
+ next-ip read-fcode#
+ get-token drop
+ >body cell -
+ ?compile-mode IF literal, postpone ! ELSE ! THEN
+ ; immediate
+
+: b(value)
+ <value> , , reveal
+ ;
+
+: b(variable)
+ <variable> , 0 , reveal
+ ;
+
+: b(constant)
+ <constant> , , reveal
+ ;
+
+: undefined-defer
+ cr cr ." Unititialized defer word has been executed!" cr cr
+ true fcode-end !
+ ;
+
+: b(defer)
+ <defer> , reveal
+ postpone undefined-defer
+ ;
+
+: b(create)
+ <variable> ,
+ postpone noop reveal
+ ;
+
+: b(field) ( E: addr -- addr+offset ) ( F: offset size -- offset+size )
+ <colon> , over literal,
+ postpone + postpone exit
+ +
+ ;
+
+: b(buffer:) ( E: -- a-addr) ( F: size -- )
+ <variable> , allot
+ ;
+
+: suspend-fcode ( -- )
+ noop \ has to be implemented more efficiently ;-)
+ ;
+
+: offset16 ( -- )
+ 16 to fcode-offset
+ ;
+
+: version1 ( -- )
+ 1 to fcode-spread
+ 8 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@
+ ;
+
+create byte-load-test-fcode
+f1 c, 08 c, 18 c, 69 c, 00 c, 00 c, 00 c, 68 c,
+12 c, 16 c, 62 c, 79 c, 74 c, 65 c, 2d c, 6c c,
+6f c, 61 c, 64 c, 2d c, 74 c, 65 c, 73 c, 74 c,
+2d c, 66 c, 63 c, 6f c, 64 c, 65 c, 21 c, 21 c,
+90 c, 92 c, ( a6 c, a7 c, 2e c, ) 00 c,
+
+: byte-load-test
+ byte-load-test-fcode ['] w@
+ ; immediate
+
+: fcode-ms
+ s" ms" $find IF 0= IF compile, ELSE execute THEN THEN ; immediate
+
+: fcode-$find
+ $find
+ IF
+ drop true
+ ELSE
+ false
+ THEN
+ ;
+
+( ---------------------------------------------------- )
diff --git a/slof/fs/fcode/big.fs b/slof/fs/fcode/big.fs
new file mode 100644
index 0000000..c2cb8d9
--- /dev/null
+++ b/slof/fs/fcode/big.fs
@@ -0,0 +1,45 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2007 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
+\ ****************************************************************************/
+
+\ big-endian
+
+( ---------------------------------------------------- )
+
+: 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 @
+ ;
+
+( ---------------------------------------------------- )
diff --git a/slof/fs/fcode/core.fs b/slof/fs/fcode/core.fs
new file mode 100644
index 0000000..8cfadeb
--- /dev/null
+++ b/slof/fs/fcode/core.fs
@@ -0,0 +1,169 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2007 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 16 =
+ ;
+
+: ?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
+ ;
+
+-1 VALUE break-fcode-addr
+
+: exec ( FCode# -- )
+
+ eva-debug? IF
+ dup
+ get-ip 8 u.r ." : "
+ ." [" 3 u.r ." ] "
+ THEN
+ get-ip break-fcode-addr = IF
+ TRUE fcode-end ! drop EXIT
+ THEN
+
+ get-token 0= IF \ imm == 0 == false
+ ?compile-mode IF
+ compile,
+ ELSE
+ eva-debug? IF dup xt>name type space THEN
+ execute
+ THEN
+ ELSE \ immediate
+ eva-debug? IF dup xt>name type space THEN
+ execute
+ THEN
+ eva-debug? IF .s cr THEN
+ ;
+
+( ---------------------------------------------------- )
+
+0 ?bigendian INCLUDE? big.fs
+0 ?bigendian NOT INCLUDE? little.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
+ ;
+
+: evaluate-fcode ( -- )
+ fcode@ exec \ read start code
+ BEGIN
+ next-ip fcode@ exec
+ fcode-end @
+ UNTIL
+ ;
+
+: step-fcode ( -- )
+ break-fcode-addr >r -1 to break-fcode-addr
+ fcode@ exec next-ip
+ r> to break-fcode-addr
+;
+
+
+( ---------------------------------------------------- )
diff --git a/slof/fs/fcode/evaluator.fs b/slof/fs/fcode/evaluator.fs
new file mode 100644
index 0000000..a0249ab
--- /dev/null
+++ b/slof/fs/fcode/evaluator.fs
@@ -0,0 +1,99 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2007 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
+\ ****************************************************************************/
+
+( eva - gordons fcode bytecode evaluator )
+
+hex
+
+-1 constant true
+ 0 constant false
+
+variable ip
+variable fcode-end
+variable fcode-num
+ 1 value fcode-spread
+16 value fcode-offset
+false value eva-debug?
+false 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
+
+0 value buff
+0 value buff-size
+
+( ---------------------------------------------------- )
+
+' read-fcode# to fcode@
+
+: step next-ip fcode@ exec ; immediate
+( ---------------------------------------------------- )
+
+: rom-code-ignored ( image# name len -- )
+ diagnostic-mode? IF type ." code found in image " . ." , ignoring ..." cr
+ ELSE 3drop THEN
+;
+
+: pci-find-rom ( baseaddr -- addr )
+ -8 and dup IF
+ dup rw@ 55aa = IF
+ diagnostic-mode? IF ." Device ROM found at " dup . cr THEN
+ ELSE drop 0 THEN
+ THEN
+;
+
+: pci-find-fcode ( baseaddr -- addr len | false )
+ pci-find-rom ?dup IF
+ dup 18 + rw@ wbflip +
+ 0 swap BEGIN
+ dup rl@ 50434952 ( 'PCIR') <> IF
+ diagnostic-mode? IF
+ ." Invalid PCI Data structure, ignoring ROM contents" cr
+ THEN
+ 2drop false EXIT
+ THEN
+ dup 14 + rb@ CASE
+ 0 OF over . s" Intel x86 BIOS" rom-code-ignored ENDOF
+ 1 OF swap diagnostic-mode? IF
+ ." Open Firmware FCode found at image " . cr
+ ELSE drop THEN
+ dup a + rw@ wbflip over + \ This code start
+ swap 10 + rw@ wbflip 200 * \ This code length
+ EXIT
+ ENDOF
+ 2 OF over . s" HP PA RISC" rom-code-ignored ENDOF
+ 3 OF over . s" EFI" rom-code-ignored ENDOF
+ dup OF over . s" Unknown type" rom-code-ignored ENDOF
+ ENDCASE
+ dup 15 + rb@ 80 and IF 2drop EXIT THEN \ End of last image
+ dup 10 + rw@ wbflip 200 * + \ Next image start
+ swap 1+ swap \ Next image #
+ 0 UNTIL
+ THEN false
+;
+
+: execute-rom-fcode ( addr len | false -- )
+ ?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
+;
diff --git a/slof/fs/fcode/tokens.fs b/slof/fs/fcode/tokens.fs
new file mode 100644
index 0000000..bf76b8b
--- /dev/null
+++ b/slof/fs/fcode/tokens.fs
@@ -0,0 +1,411 @@
+\ *****************************************************************************
+\ * Copyright (c) 2004, 2007 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 ;
+
+
+: 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
+
+\ ' ferror 1 08 set-token
+\ ' ferror 1 09 set-token
+\ ' ferror 1 0a set-token
+\ ' ferror 1 0b set-token
+\ ' ferror 1 0c set-token
+\ ' ferror 1 0d set-token
+\ ' ferror 1 0e set-token
+\ ' ferror 1 0f set-token
+
+' 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
+' l@ 0 6E set-token
+' w@ 0 6F set-token
+' <w@ 0 70 set-token
+' c@ 0 71 set-token
+' ! 0 72 set-token
+' l! 0 73 set-token
+' w! 0 74 set-token
+' c! 0 75 set-token
+' 2@ 0 76 set-token
+' 2! 0 77 set-token
+' move 0 78 set-token
+' 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 \ alloc-mem
+' free-mem 0 8C set-token \ free-mem
+' 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 \ should be (cr but terminal support is not
+ \ available
+' 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
+' $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
+\ ' ferror 0 B3 set-token
+\ ' ferror 0 B4 set-token
+' new-token 0 B5 set-token
+' named-token 0 B6 set-token
+\ fcode-debug? IF
+' b(:) 1 B7 set-token
+\ ELSE
+\ ' b(:) 1 B7 set-token
+\ THEN
+' 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
+\ ' ferror 0 BF set-token
+' INSTANCE 0 C0 set-token
+\ ' noop 1 C0 set-token
+\ ' ferror 0 C1 set-token
+\ fcode-debug? IF
+' b(;) 1 C2 set-token
+\ ELSE
+\ ' b(;) 1 C2 set-token
+\ THEN
+' 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
+
+' start0 0 F0 set-token
+' start1 0 F1 set-token
+' start2 0 F2 set-token
+' start4 0 F3 set-token
+
+' ferror 0 FC set-token
+' version1 0 FD set-token
+
+\ ' 4-byte-id 0 FE set-token \ Historical
+' end1 0 FF set-token
+
+\ ' dma-alloc 0 101 set-token
+' my-address 0 102 set-token
+' my-space 0 103 set-token
+' 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
+' model 0 119 set-token
+' device-type 0 11A set-token
+' parse-2int 0 11B set-token
+' is-install 0 11C set-token
+' is-remove 0 11D set-token
+' is-selftest 0 11E set-token
+' new-device 0 11F set-token
+' diagnostic-mode? 0 120 set-token
+' memory-test-suite 0 122 set-token
+' 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
+' #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
+
+' 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
+
+' 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
+
+' fb8-install 0 18B set-token
+
+' 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
+' my-unit 0 20D set-token
+' $call-method 0 20E set-token
+' $open-package 0 20F set-token
+' (is-user-word) 0 214 set-token
+' suspend-fcode 0 215 set-token
+\ ' abort 0 216 set-token
+' fc-abort 0 216 set-token
+' catch 0 217 set-token
+' throw 0 218 set-token
+' 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
+' rx@ 0 22E set-token
+' rx! 0 22F set-token
+' rb@ 0 230 set-token
+' rb! 0 231 set-token
+' rw@ 0 232 set-token
+' rw! 0 233 set-token
+' rl@ 0 234 set-token
+' rl! 0 235 set-token
+' wbflips 0 236 set-token
+' lwflips 0 237 set-token
+\ ' probe 0 238 set-token
+\ ' probe-virtual 0 239 set-token
+\ 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
+' bxjoin 0 241 set-token
+' <l@ 0 242 set-token
+' lxjoin 0 243 set-token
+' wxjoin 0 244 set-token
+' x, 0 245 set-token
+' x@ 0 246 set-token
+' 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 254 RESERVED FCODES
+\ ...
+\ 0 5FF RESERVED FCODES
+
+\ 0 600 VENDOR FCODES
+\ ...
+\ 0 7FF VENDOR FCODES
+
+\ 0 800 LOCAL FCODES
+\ ...
+\ 0 FFF LOCAL FCODES
+